在 Excel VBA 中过滤二维数组

Question

使用 Excel 和 VBA，我想要一些关于如何严格使用 VBA 最好地过滤数组中的数据（与使用数据透视表的方式相同）的建议。我正在创建一个用户窗体，它将根据当前现有的数据做出一些数据决策。我可以想象如何做得足够好，但我不太精通 VBA 编程。

这是一个例子

A       B       C
bob     12      Small
sam     16      Large
sally   1346    Large
sam     13      Small
sally   65      Medium
bob     1       Medium

要获取数组中的数据，我可以使用

Dim my_array As Variant

my_array = Range("A1").CurrentRegion

现在，我熟悉了循环遍历 2D 数组，但我想知道：过滤 2D 数组数据最有效的方法是什么（无需一次又一次循环遍历数组）？

比如说我怎么获取就是说获取这样的数据：

data_for_sally As Variant 'rows with sally as name in ColA
data_for_sally_less_than_ten As Variant ' all rows with sally's name in ColA and colB < 10
data_for_all_mediums as Variant ' all rows where ColC is Medium

建议？我可以用一堆自定义函数和循环来解决这个问题，但我认为一定有更好的方法。谢谢。

Answer 1

我假设您只想使用 VBA。

我认为这取决于几个参数，主要是：

• 您运行相同条件的频率 => 您存储过滤器的结果还是每次都重新计算？
• 您需要多久过滤一次内容 => 如果经常，那么值得拥有适当的代码结构，如果不是，那么一次性循环显然是可行的方法。

从面向对象的角度来看，假设性能（速度和内存）不是问题，我会采用以下设计（我不会详细介绍实现的细节，只给出总体思路）。创建一个可以像这样使用的类（让我们想象地称之为 ArrayFilter）。

设置过滤器

Dim filter As New ArrayFilter
With filter
    .name = "sam"
    .category = "Medium"
    .maxValue = 10
End With

或者

filter.add(1, "sam") 'column 1
filter.add(3, "Medium") 'column 3
filter.addMax(2, 10) 'column 2

创建过滤后的数据集

filteredArray = getFilteredArray(originalArray, filter)

getFilteredArray 编写起来相当简单：您循环遍历数组，检查值是否与过滤器匹配，并将有效行放入新数组中：

If filter.isValidLine(originalArray, lineNumber) Then 'append to new array

优点

• 简洁的设计
• 可重复使用，尤其是使用列号的第二个版本。这确实可以用来过滤任何数组。
• 过滤代码位于一个可以测试的函数中
• 推论：避免重复代码

缺点

• 每次都会重新计算过滤，即使您使用相同的过滤器两次。例如，您可以将结果存储在字典中 - 见下文。
• 内存：每次调用 getFilteredArray 都会创建一个新数组，但不确定如何避免这种情况
• 这增加了相当多的代码行，所以只有当它有助于使代码更易于阅读/维护时我才会这样做。

ps：如果需要缓存结果以提高性能，一种方法是将结果存储在字典中，并向 getFilteredArray 函数添加一些逻辑。请注意，除非您的数组非常大和/或您经常运行相同的过滤器，否则这可能不值得。

filters.add filter, filteredArray 'filters is a dictionary

这样，当你下次调用 getFilteredArray 时，你可以这样做：

For each f in filters
    'Check if all conditions in f and newFilter are the same
    'If they are:
    getFilteredArray = filters(f)
    Exit Function
Next

'Not found in cache: compute the result

Answer 2

试试这个

' credited to ndu
Function Filter2DArray(ByVal sArray, ByVal ColIndex As Long, ByVal FindStr As String, ByVal HasTitle As Boolean)
  Dim tmpArr, i As Long, j As Long, Arr, Dic, TmpStr, Tmp, Chk As Boolean, TmpVal As Double
  On Error Resume Next
  Set Dic = CreateObject("Scripting.Dictionary")
  tmpArr = sArray
  ColIndex = ColIndex + LBound(tmpArr, 2) - 1
  Chk = (InStr("><=", Left(FindStr, 1)) > 0)
  For i = LBound(tmpArr, 1) - HasTitle To UBound(tmpArr, 1)
    If Chk Then
      TmpVal = CDbl(tmpArr(i, ColIndex))
      If Evaluate(TmpVal & FindStr) Then Dic.Add i, ""
    Else
      If UCase(tmpArr(i, ColIndex)) Like UCase(FindStr) Then Dic.Add i, "" 'This finds only exact matches, if you need *FindStr* use:  If UCase(tmpArr(i, ColIndex)) Like UCase("*" & FindStr & "*") Then Dic.Add i, ""

    End If
  Next
  If Dic.Count > 0 Then
    Tmp = Dic.Keys
    ReDim Arr(LBound(tmpArr, 1) To UBound(Tmp) + LBound(tmpArr, 1) - HasTitle, LBound(tmpArr, 2) To UBound(tmpArr, 2))
    For i = LBound(tmpArr, 1) - HasTitle To UBound(Tmp) + LBound(tmpArr, 1) - HasTitle
      For j = LBound(tmpArr, 2) To UBound(tmpArr, 2)
        Arr(i, j) = tmpArr(Tmp(i - LBound(tmpArr, 1) + HasTitle), j)
      Next
    Next
    If HasTitle Then
      For j = LBound(tmpArr, 2) To UBound(tmpArr, 2)
        Arr(LBound(tmpArr, 1), j) = tmpArr(LBound(tmpArr, 1), j)
      Next
    End If
  End If
  Filter2DArray = Arr
End Function

Answer 3

今天我被困在这个问题上。 我的解决方案与 @assylias 发布的解决方案类似，因为我还创建了一个新数组，其中应用了过滤器进行处理。

还有其他方法可以执行此操作（例如转置和保留），但此方法允许您仅使用一次 redim 来执行过滤器，并且不会丢失原始数组上的数据。

如果您的输入数据已经排序，则效果最佳，因为除非您创建额外的索引字段，否则您将无法找到输入数组中的位置以直接对这些项目执行操作。

请注意，在此示例中，输入数组是从

 listobject.databodyrange

创建的

Private Function FilterArray(aInput As Variant, FCriteria As String, aInputColCount) Variant

Dim i as integer, j As Integer, k As Integer
Dim fArray() As Variant
Dim RowCount As Integer

RowCount = 0

'Validate the input array
If Not IsArray(aInput) Then
   Debug.Print ("Error: Input to Function[FilterArray] is not an array") & vbNewLine
   Exit Function
End If

'count the number of records that match the search criteria in the input array, here I use the 13th column.
For i = 1 To UBound(aInput) 
    If aInput(i, 13) = FCriteria Then: RowCount = RowCount + 1
Next

'define the array size for your filtered array.
ReDim fArray(1 To RowCount, 1 To aInputColCount) As Variant

k = 1
For i = 1 To ubound(aInput)
    If aInput(i, 13) = FCriteria Then
    'populate a row in your filtered array
       For j = 1 To aInputColCount 
          fArray(k, j) = aInput(i, j)
          k = k + 1
       Next j
     End If 
Next i

FilterArray = fArray

End Function