VBA (Excel)：基于多个搜索条件的查找，无需循环

Question

我有一个大型数据表，我想根据 3 组条件在 VBA 中进行搜索。可以假定每个行条目是唯一的。表格/数据本身的格式不能因要求而改变。 （我看过几篇关于相关问题的帖子，但还没有找到可行的解决方案。）

一开始我在循环中使用了经典的VBA find 方法：

Set foundItem = itemRange.Find(What:=itemName, Lookin:=xlValues, lookat:=xlWhole, SearchOrder:=xlByRows)
If Not foundItem Is Nothing Then
    firstMatchAddr = foundItem.Address
    Do
        ' *Check the other fields in this row for a match and exit if found*
        Set foundItem = itemRange.FindNext(foundItem)
    Loop While foundItem.Address <> firstMatchAddr  And Not foundItem Is Nothing
End If

但是因为这需要在大量数据上调用多次，所以速度并不好。

我做了一些搜索，发现我可以将match 方法与index 一起使用。所以我尝试了很多变体都没有成功，例如：

result = Evaluate("=MATCH(1, (""" & criteria1Name & """=A2:A" & lastRow & ")*(""" & criteria2Name & """=B2:B" & lastRow & ")*(""" & criteria3Name & """=C2:C" & lastRow & "), 0)")

和

result = Application.WorksheetFunction.Index(resultRange, Application.WorksheetFunction.Match((criteria1Name = criteria1Range)*(criteria2Name = criteria2Range)*(criteria3Name = criteria3Range))

和

result = Application.WorksheetFunction.Index(resultRange, Application.WorksheetFunction.Match((criteria1Range=criteria1Name )*(criteria2Range=criteria2Name )*(criteria3Range=criteria3Name ))

然后我尝试使用AutoFilter 进行排序：

.Range(.Cells(1,1), .Cells(lastRow, lastCol)).AutoFilter Field:=1, Criteria1:="=" & criteria1Name
.Range(.Cells(1,1), .Cells(lastRow, lastCol)).AutoFilter Field:=2, Criteria1:="=" & criteria2Name
.Range(.Cells(1,1), .Cells(lastRow, lastCol)).AutoFilter Field:=3, Criteria1:="=" & criteria3Name

但是因为其中一个排序列包含日期，所以我无法让 AutoFilter 正常工作。

我的问题是，如何在 Excel VBA 中根据多个条件搜索列，不循环，返回行号或我在该行的单元格中的值有兴趣？

Answer 1

您可以使用高级过滤器。将列标题放在工作表的单独部分（或完全不同的工作表）。在这些列标题下，将您要在每一列中查找的条件放入其中。然后将该范围（包括标题）命名为“Criteria”之类的名称。那么宏就变成了：

Sub Macro1()

    Sheets("Sheet1").Range("A1").CurrentRegion.AdvancedFilter xlFilterInPlace, Range("Criteria")

End Sub

作为我下面评论的后续，让 VBA 在幕后创建标准范围：

Sub Macro1()

    'Code up here that defines the criteria

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    With Sheets.Add
        'Create the advanced filter criteria range
        .Range("A1") = "HeaderA"
        .Range("B1") = "HeaderB"
        .Range("C1") = "HeaderC"
        .Range("A2") = criteria1Name
        .Range("B2") = criteria2Name
        .Range("C2") = criteria3Name

        'Alternately, to save space:
        '.Range("A1:C1").Value = Array("HeaderA", "HeaderB", "HeaderC")
        '.Range("A2:C2").Value = Array(criteria1Name, criteria2Name, criteria3Name)

        'Then perform the advanced filter
        Sheets("Sheet1").Range("A1").CurrentRegion.AdvancedFilter xlFilterInPlace, .Range("A1:C2")

        'Remove behind the scenes sheet now that the filter is completed
        .Delete
    End With

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub

Answer 2

您可以将EVALUATE 用于多个条件，例如返回数学值的行号。这使用与Is it possible to fill an array with row numbers which match a certain criteria without looping?相同的方法

• 它搜索 50000 行来匹配
  • A 列中的前四个字母与fred 匹配
  • B 中的日期大于1/1/2001
  • apple 在第 5 列中
• 任何符合这些条件的行都会重新调整为x 中的行号

（下图中第 1 行和第 5 行）

代码

Sub GetEm2()
x = Filter(Application.Transpose(Application.Evaluate("=IF((LEFT(A1:A10000,4)=""fred"")*(B1:B10000>date(2001,1,1))*(C1:C10000=""apple""),ROW(A1:A10000),""x"")")), "x", False)
End Sub

Application.Transpose 限制为 65536 个单元格，因此需要将更长的范围“分块”成碎片。