在Excel VBA中过滤2D数组
使用Excel和VBA，我想了解如何最好地过滤数组中的数据（采用与数据透视表相同的方式），严格使用VBA。 我正在创build一个用户窗体，它将根据当前存在的数据做出一些数据决定。 我可以想象如何做到这一点，但不熟悉VBA编程。
这是一个例子
ABC 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数组，但我想知道： 什么是最有效的方法来过滤二维数组数据 （不循环数组一次又一次）？
例如，我怎么会得到这样的数据：
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
build议？ 我可以用一堆自定义函数和循环来解决这个问题，但是我认为必须有更好的方法。 谢谢。
我假设你只想使用VBA。
我认为这取决于几个参数，主要是：
- 你运行相同条件的频率是多less？>是否存储filter的结果或每次重新计算？
- 多久你需要过滤东西=>如果经常，值得拥有一个合适的代码结构，如果没有，那么一个一个循环显然是要走的路。
从OO的angular度来看，假设性能（速度和内存）不是问题，我会去下面的devise（我不会详细介绍实现，只是给出一般的想法）。 创build一个类（让我们把它称为有想象力的ArrayFilter），你可以像这样使用。
设置filter
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
创build过滤的数据集
filteredArray = getFilteredArray(originalArray, filter)
getFilteredArray写起来相当简单：循环遍历数组检查值是否与filter匹配，并将有效行放入新数组中：
If filter.isValidLine(originalArray, lineNumber) Then 'append to new array
优点
- 干净的devise
- 可重复使用，特别是在使用列号的第二个版本时。 这可以用来真正地过滤任何数组。
- 筛选代码是一个你可以testing的function
- 推论：避免重复的代码
缺点
- 即使您使用相同的filter两次，每次都会重新计算过滤。 您可以将结果存储在词典中，例如 – 见下文。
- 内存：每次调用getFilteredArray创build一个新的数组，但不知道如何可以避免这种情况
- 这增加了相当多的代码行，所以只有在代码更易于读取/维护的情况下，才能做到这一点。
ps：如果需要caching结果以提高性能，一种方法是将结果存储在字典中，并向getFilteredArray函数添加一些逻辑。 请注意，除非您的arrays真的很大，并且/或者您运行相同的filter很多，这可能是不值得的。
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
尝试这个
' 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, "" 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