Найти все совпадения в книге с помощью Excel VBA

Я пытаюсь написать подпрограмму VBA, которая возьмет строку, выполнит поиск в заданной книге Excel и вернет мне все возможные совпадения.

В настоящее время у меня есть реализация, которая работает, но она очень медленная, поскольку она представляет собой цикл double. Конечно, встроенная функция Excel Find "оптимизирована", чтобы найти одно совпадение, но мне бы хотелось, чтобы она возвращала массив начальных совпадений, которые затем можно применить к другим методам.

Я выложу некоторый псевдокод того, что у меня уже есть

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

Как было сказано ранее, этот цикл double for делает работу очень медленной, поэтому я стараюсь избавиться от этого, если это возможно. Любые предложения?

UPDATE

В то время как ответы ниже позволили бы улучшить мой метод, я закончил с чем-то немного отличающимся, поскольку мне нужно было делать несколько запросов снова и снова.

Вместо этого я решил пропустить все строки в моем документе и создать словарь, содержащий ключ для каждой уникальной строки. Значение, на которое это указывает, станет списком возможных совпадений, поэтому, когда я буду запрашивать позже, я просто могу проверить, существует ли он, и если да, просто получите быстрый список совпадений.

В основном просто выполняет одну начальную развертку для хранения всего в управляемой структуре, а затем запрашивает эту структуру, которая может быть выполнена в O(1) time

Ответы

Ответ 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

Ответ 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 Loop, чтобы вы не попали в бесконечный цикл... Ссылка на первый найденный адрес ячейки и сравнение после каждого оператора FindNext, чтобы убедиться, что он не вернулся к первому изначально найденная ячейка.

Ответ 3

Вы можете использовать метод Range.Find:

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

Это даст вам первую ячейку, содержащую строку поиска. Повторяя это с установкой аргумента "После" следующей ячейке, вы получите все другие вхождения, пока не вернетесь в первое вхождение.

Скорее всего, это будет намного быстрее.

Ответ 5

Ниже код избегает создания бесконечного цикла. Предположим, что 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

Ответ 6

Основываясь на идее ответа 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

Ответ 7

В моем сценарии мне нужно искать значение в столбце 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