Question

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

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

我将发布一些已经存在的伪代码

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

如前所述，这个双循环使得运行速度非常慢，所以我希望尽可能摆脱这种情况。有什么建议吗？

更新

虽然下面的答案会改进我的方法，但我最终会遇到一些略有不同的事情，因为我需要一遍又一遍地进行多次查询。

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

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

Answer 1

如上所述，使用Range.Find方法以及工作簿中每个工作表的循环是最快的方法。例如，下面的字符串“Question？”在每个工作表中，并用字符串“已回答！”替换它。

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

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

Answer 3

您可以使用Range.Find方法：

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

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

这可能会快得多。

Answer 4

基于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 5

根据艾哈迈德（Ahmed）的回答，在进行了一些整理和归纳之后，包括其他“查找”（Find）参数，因此我们可以在任何情况下使用此功能：

'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

Answer 6

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

Pass cell contents into VBA Array

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

Answer 8

在我的Scenario中，我必须在A列中查找值，并且需要找出B列中的匹配。所以我创建了一个for循环，在其中将查找整个列A并从B列获得完全匹配。

Sub Type3()

Dim loc As String
Dim k As Integer
Dim i As Integer
Dim j As Integer
Dim findpage As String
Dim methodlist As String    

findpage = "benefits" 'We can change this values as  dynamic
k = Sheet1.Range("A1048576").End(xlUp).Row

For i = 1 To k
         loc = Sheet1.Cells(i, 1).Value           
        If StrComp(findpage, loc) = 0 Then                   
                 method = Cells(i, 2).Value
                 methodlist = methodlist + "," + method   'We can use string array as well                                   
        End If         
Next i            
End Sub

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

8 个答案: