Excel 用列表对象列范围的非空白值填充的数组

Excel array Populated with non blank values of listobject column range

我有一列列表对象,开头有一些非空值。假设前 15 个值不为空。

我知道可以像这样将范围的值传递给数组:

Dim mylistObject As ListObject
    Set mylistObject = ThisWorkbook.Sheets("training").ListObjects(1)

Dim theArray() As Variant
   theArray = mylistObject.listcolumn(1).DataBodyRange.value

问题是我怎样才能只传递非空值。 我知道如何用循环来做,但这里的关键是速度,如果列表对象有数百行并且操作完成数十次,它会花费太长时间。

我也知道可以计算非空白单元格的数量并相应地重新调整数组并循环遍历值。还是不够优雅。

有什么想法吗?应该有一种方法可以用 VBA 语言

来表达
mylistObject.listcolumn(1).DataBodyRange.value
' but not all the range but the non empty ones.

非常感谢

利用Application.Index函数的可能性

演示创建和转换列表框的列数据数组的简单方法:

  1. 获取原始 post 中已显示的第一列的所有数据(包括空格)(顺便说一下,数组赋值中的正确语法是 theArray = mylistObject.ListColumns(1).DataBodyRange.Value 和最后的 "s".ListColumns)

  2. 使用 Application.Index 函数的高级功能和从属函数调用 (getNonBlankRowNums())

    消除空白行号

    一个代码行的基本转换语法:

   newArray = Application.Index(oldArray, Application.Transpose(RowArray), ColumnArray)

其中 RowArray / ColumnArray 代表(剩余)row 数字.

相关link:


Sub NonBlanks()
  ' Note: encourageing to reference a sheet via CodeName instead of Thisworkbook.Worksheets("training")
  '       i.e. change the (Name) property in the VBE properties tool window (F4) for the referenced worksheet
  '       (c.f. 
    Dim mylistObject As ListObject
    Set mylistObject = training.ListObjects(1)
    
  ' [1] Get data of first column (including blanks)
    Dim theArray As Variant
    theArray = mylistObject.ListColumns(1).DataBodyRange.Value   ' LISTCOLUMNS with final S!!

  ' [2] eliminate blank row numbers
    theArray = Application.Index(theArray, Application.Transpose(getNonBlankRowNums(theArray)), Array(1))

End Sub
Function getNonBlankRowNums(arr, Optional ByVal col = 1) As Variant()
' Purpose: return 1-dim array with remaining non-blank row numbers
  Dim i&, ii&, tmp
  ReDim tmp(1 To UBound(arr))
  For i = 1 To UBound(arr)
      If arr(i, col) <> vbNullString Then   ' check for non-blanks
          ii = ii + 1                       ' increment temporary items counter
          tmp(ii) = i                       ' enter row number
      End If
  Next i
  ReDim Preserve tmp(1 To ii)               ' redim to final size preserving existing items
' return function value (variant array)
  getNonBlankRowNums = tmp
End Function