首页 > 解决方案 > Excel 数组填充了 listobject 列范围的非空白值

问题描述

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

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

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

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

问题是我怎样才能只传递非空白值。我知道如何使用循环来做到这一点,但这里的关键是速度,如果 listobject 有数百行并且操作完成了数十次,则需要太长时间。

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

任何想法?应该有一种方法可以用 VBA 语言来讲述

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

非常感谢

标签: arraysexcelrangelistobject

解决方案


使用Application.Index功能的可能性

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

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

  2. Application.Index使用函数的高级特性和从属函数调用 ( getNonBlankRowNums())消除空白行号

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

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

其中RowArray / ColumnArray代表(剩余)号或 的数组。

相关链接:Application.Index 函数的一些特性


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. https://stackoverflow.com/questions/58507542/set-up-variable-to-refer-to-sheet/58508735#58508735)
    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


推荐阅读