使用Excel VBA在工作簿中查找所有匹配项

Question

我正在尝试编写一个VBA例程，该例程将使用字符串，搜索给定的Excel工作簿，并向我返回所有可能的匹配项。我目前有一个可行的实现，但是它非常慢，因为它是double for循环。当然，内置的Excel Find函数经过“优化”以查找单个匹配项，但是我希望它返回一个初始匹配项数组，然后可以将其应用于其他方法。我将发布一些我已经拥有的伪代码For all sheets in workbook    For all used rows in worksheet        If cell matches search string            do some stuff        end    endend如前所述，此double for循环使事情运行非常缓慢，因此，我希望尽可能消除这种情况。有什么建议么？更新尽管下面的答案可以改善我的方法，但由于需要一遍又一遍地进行多次查询，最终我得到了些许不同。相反，我决定遍历文档中的所有行，并为每个唯一行创建一个包含键的字典。然后，此指向的值将是可能匹配项的列表，以便稍后查询时，我可以仅检查它是否存在，如果存在，则可以快速获取匹配项列表。基本上只是在做一个初始扫描存储一切都在一个可管理的结构，然后查询该结构可以在完成O(1)时间

Answer 1

如上所述，使用Range.Find方法以及工作簿中每个工作表的循环是最快的方法。例如，以下代码查找字符串“ Question？”。在每个工作表中，并将其替换为字符串“ Answered！”。

Sub FindAndExecute()

Dim Sh As Worksheet

Dim Loc As Range

For Each Sh In ThisWorkbook.Worksheets

    With Sh.UsedRange

        Set Loc = .Cells.Find(What:="Question?")

        If Not Loc Is Nothing Then

            Do Until Loc Is Nothing

                Loc.Value = "Answered!"

                Set Loc = .FindNext(Loc)

            Loop

        End If

    End With

    Set Loc = Nothing

Next

End Sub

Answer 2

Function GetSearchArray(strSearch)

Dim strResults As String

Dim SHT As Worksheet

Dim rFND As Range

Dim sFirstAddress

For Each SHT In ThisWorkbook.Worksheets

    Set rFND = Nothing

    With SHT.UsedRange

        Set rFND = .Cells.Find(What:=strSearch, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlRows, SearchDirection:=xlNext, MatchCase:=False)

        If Not rFND Is Nothing Then

            sFirstAddress = rFND.Address

            Do

                If strResults = vbNullString Then

                    strResults = "Worksheet(" & SHT.Index & ").Range(" & Chr(34) & rFND.Address & Chr(34) & ")"

                Else

                    strResults = strResults & "|" & "Worksheet(" & SHT.Index & ").Range(" & Chr(34) & rFND.Address & Chr(34) & ")"

                End If

                Set rFND = .FindNext(rFND)

            Loop While Not rFND Is Nothing And rFND.Address <> sFirstAddress

        End If

    End With

Next

If strResults = vbNullString Then

    GetSearchArray = Null

ElseIf InStr(1, strResults, "|", 1) = 0 Then

    GetSearchArray = Array(strResults)

Else

    GetSearchArray = Split(strResults, "|")

End If

End Function

Sub test2()

For Each X In GetSearchArray("1")

    Debug.Print X

Next

End Sub

在执行“查找循环”时要小心，不要使自己陷入无限循环...请引用第一个找到的单元格地址，并在每个“ FindNext”语句之后进行比较，以确保它没有返回到最初找到的第一个单元格。