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

Question

我正在尝试编写一个VBA例程，该例程将接受一个字符串，搜索给定的 Excel 工作簿，并将所有可能的匹配项返回给我。

我目前有一个可行的实现，但它非常慢，因为它是一个双 for 循环。当然，内置的 ExcelFind函数已“优化”以查找单个匹配项，但我希望它返回一组初始匹配项，然后我可以对其应用进一步的方法。

我将发布一些我已经拥有的伪代码

For all sheets in workbook
    For all used rows in worksheet
        If cell matches search string
            do some stuff
        end
    end
end

如前所述，这个双重 for 循环使事情运行非常缓慢，所以我希望尽可能摆脱它。有什么建议么？

更新

虽然下面的答案会改进我的方法，但我最终选择了一些稍微不同的东西，因为我需要一遍又一遍地进行多个查询。

相反，我决定遍历文档中的所有行并创建一个字典，其中包含每个唯一行的键。this 指向的值将是一个可能匹配的列表，因此当我稍后查询时，我可以简单地检查它是否存在，如果存在，只需获取一个快速的匹配列表。

基本上只需进行一次初始扫描以将所有内容存储在可管理的结构中，然后查询可以及时完成的O(1)​​结构

Answer 1

如上所述，使用 Range.Find 方法以及工作簿中每个工作表的循环是执行此操作的最快方法。例如，以下内容定位字符串“问题？” 在每个工作表中并将其替换为字符串“已回答！”。

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

根据艾哈迈德的回答，经过一些清理和概括，包括其他“查找”参数，所以我们可以在任何情况下使用这个函数：

'Uses Range.Find to get a range of all find results within a worksheet
' Same as Find All from search dialog box
'
Function FindAll(rng As Range, What As Variant, Optional LookIn As XlFindLookIn = xlValues, Optional LookAt As XlLookAt = xlWhole, Optional SearchOrder As XlSearchOrder = xlByColumns, Optional SearchDirection As XlSearchDirection = xlNext, Optional MatchCase As Boolean = False, Optional MatchByte As Boolean = False, Optional SearchFormat As Boolean = False) As Range
    Dim SearchResult As Range
    Dim firstMatch As String
    With rng
        Set SearchResult = .Find(What, , LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)
        If Not SearchResult Is Nothing Then
            firstMatch = SearchResult.Address
            Do
                If FindAll Is Nothing Then
                    Set FindAll = SearchResult
                Else
                    Set FindAll = Union(FindAll, SearchResult)
                End If
                Set SearchResult = .FindNext(SearchResult)
            Loop While Not SearchResult Is Nothing And SearchResult.Address <> firstMatch
        End If
    End With
End Function

用法与本机 .Find 相同，但这里是请求的用法示例：

Sub test()
  Dim SearchRange As Range, SearchResults As Range, rng As Range
    Set SearchRange = MyWorksheet.UsedRange
    Set SearchResults = FindAll(SearchRange, "Search this")
    
    If SearchResults Is Nothing Then
        'No match found
    Else
        For Each rng In SearchResults
            'Loop for each match
        Next
    End If
End Sub

Answer 3

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”语句之后进行比较，以确保它没有返回到最初找到的第一个单元格。

Answer 4

您可以使用 Range.Find 方法：

http://msdn.microsoft.com/en-us/library/office/ff839746.aspx

这将为您提供包含搜索字符串的第一个单元格。通过将“After”参数设置为下一个单元格来重复此操作，您将获得所有其他事件，直到您回到第一次出现。

这可能会快得多。

Answer 5

基于 B Hart 的回答的想法，这是我的一个函数版本，它在一个范围内搜索一个值，并返回所有找到的范围（单元格）：

Function FindAll(ByVal rng As Range, ByVal searchTxt As String) As Range
    Dim foundCell As Range
    Dim firstAddress
    Dim rResult As Range
    With rng
        Set foundCell = .Find(What:=searchTxt, _
                              After:=.Cells(.Cells.Count), _
                              LookIn:=xlValues, _
                              LookAt:=xlWhole, _
                              SearchOrder:=xlByRows, _
                              SearchDirection:=xlNext, _
                              MatchCase:=False)
        If Not foundCell Is Nothing Then
            firstAddress = foundCell.Address
            Do
                If rResult Is Nothing Then
                    Set rResult = foundCell
                Else
                    Set rResult = Union(rResult, foundCell)
                End If
                Set foundCell = .FindNext(foundCell)
            Loop While Not foundCell Is Nothing And foundCell.Address <> firstAddress
        End If
    End With

    Set FindAll = rResult
End Function

要在整个工作簿中搜索值：

Dim wSh As Worksheet
Dim foundCells As Range
For Each wSh In ThisWorkbook.Worksheets
    Set foundCells = FindAll(wSh.UsedRange, "YourSearchString")
    If Not foundCells Is Nothing Then
        Debug.Print ("Results in sheet '" & wSh.Name & "':")
        Dim cell As Range
        For Each cell In foundCells
            Debug.Print ("The value has been found in cell: " & cell.Address)
        Next
    End If
Next

Answer 6

您可以将数据读入数组。从那里您可以在内存中进行匹配，而不是一次读取一个单元格。

将单元格内容传递到 VBA 数组

Answer 7

下面的代码避免了创建无限循环。假设 XYZ 是我们在工作簿中查找的字符串。

   Private Sub CommandButton1_Click()
   Dim Sh As Worksheet, myCounter
   Dim Loc As Range

   For Each Sh In ThisWorkbook.Worksheets
   With Sh.UsedRange
   Set Loc = .Cells.Find(What:="XYZ")

    If Not Loc Is Nothing Then

           MsgBox ("Value is found  in " & Sh.Name)
           myCounter = 1
            Set Loc = .FindNext(Loc)

    End If
End With
Next
If myCounter = 0 Then
MsgBox ("Value not present in this worrkbook")
End If

End Sub