Find all matches in workbook using Excel VBA

2020-01-23 20:57发布

I am trying to write a VBA routine that will take a string, search a given Excel workbook, and return to me all possible matches.

I currently have an implementation that works, but it is extremely slow as it is a double for loop. Of course the built in Excel Find function is "optimized" to find a single match, but I would like it to return an array of initial matches that I can then apply further methods to.

I will post some pseudocode of what I have already

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

As previously stated, this double for loop makes things run very slowly, so I am looking to get rid of this if possible. Any suggestions?

UPDATE

While the below answers would have improved my method, I ended up going with something slightly different as I needed to do multiple queries over and over.

I instead decided to loop through all rows in my document and create a dictionary containing a key for each unique row. The value this points to will then be a list of possible matches, so that when I query later, I can simply just check if it exists, and if so, just get a quick list of matches.

Basically just doing one initial sweep to store everything in a manageable structure, and then query that structure which can be done in O(1) time

8条回答
够拽才男人
2楼-- · 2020-01-23 21:05

Using the Range.Find method, as pointed out above, along with a loop for each worksheet in the workbook, is the fastest way to do this. The following, for example, locates the string "Question?" in each worksheet and replaces it with the string "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
查看更多
仙女界的扛把子
3楼-- · 2020-01-23 21:06
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

Careful when doing a Find Loop that you don't get yourself into an infinite loop... Reference the first found cell address and compare after each "FindNext" statement to make sure it hasn't returned back to the first initially found cell.

查看更多
虎瘦雄心在
4楼-- · 2020-01-23 21:07

In my Scenario, i have to look for the value in column A and need to find out the matches in column B. So i have created a for loop, inside it will look up into the entire column A and get the exact match from Column 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
查看更多
Animai°情兽
5楼-- · 2020-01-23 21:09

Below code avoids creating infinite loop. Assume XYZ is the string which we are looking for in the workbook.

   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
查看更多
做个烂人
6楼-- · 2020-01-23 21:10

Based on Ahmed's answer, after some cleaning up and generalization, including the other "Find" parameters, so we can use this function in any situation:

'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
查看更多
劫难
7楼-- · 2020-01-23 21:13

You can read the data into an array. From there you can do the match in memory, instead of reading one cell at a time.

Pass cell contents into VBA Array

查看更多
登录 后发表回答