Trouver toutes les correspondances dans le classeur à l'aide d'Excel VBA
J'essaie d'écrire une routine VBA qui prendra une chaîne, recherchera un classeur Excel donné et me renverra toutes les correspondances possibles.
J'ai actuellement une implémentation qui fonctionne, mais elle est extrêmement lente car c'est une boucle double. Bien sûr, la fonction Excel Find intégrée est "optimisée" pour trouver une seule correspondance, mais j'aimerais qu'elle renvoie un tableau de correspondances initiales auxquelles je peux ensuite appliquer d'autres méthodes.
Je posterai un pseudocode de ce que j'ai déjà
For all sheets in workbook
For all used rows in worksheet
If cell matches search string
do some stuff
end
end
end
Comme indiqué précédemment, cette double boucle for fait tourner les choses très lentement, donc je cherche à m'en débarrasser si possible. Aucune suggestion?
MISE À JOUR
Bien que les réponses ci-dessous auraient amélioré ma méthode, j'ai fini par choisir quelque chose de légèrement différent car j'avais besoin de faire plusieurs requêtes encore et encore.
J'ai plutôt décidé de parcourir toutes les lignes de mon document et de créer un dictionnaire contenant une clé pour chaque ligne unique. La valeur vers laquelle cela pointe sera alors une liste de correspondances possibles, de sorte que lorsque j'interrogerai plus tard, je pourrai simplement vérifier si elle existe, et si c'est le cas, obtenir simplement une liste rapide de correspondances.
Fondamentalement, il suffit de faire un balayage initial pour tout stocker dans une structure gérable, puis interroger cette structure qui peut être effectuée dans O(1) temps
L'utilisation de la méthode Range.Find, comme indiqué ci-dessus, avec une boucle pour chaque feuille de calcul du classeur, est le moyen le plus rapide de le faire. Ce qui suit, par exemple, localise la chaîne "Question?" dans chaque feuille de calcul et la remplace par la chaîne "Répondu!".
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
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
Attention lorsque vous effectuez une boucle de recherche que vous ne vous retrouvez pas dans une boucle infinie ... Référencez la première adresse de cellule trouvée et comparez après chaque instruction "FindNext" pour vous assurer qu'elle n'est pas revenue à la première cellule trouvée initialement.
Vous pouvez utiliser la méthode Range.Find:
http://msdn.Microsoft.com/en-us/library/office/ff839746.aspx
Cela vous donnera la première cellule qui contient la chaîne de recherche. En répétant cela en définissant l'argument "Après" à la cellule suivante, vous obtiendrez toutes les autres occurrences jusqu'à ce que vous soyez de retour à la première occurrence.
Ce sera probablement beaucoup plus rapide.
Basé sur l'idée de la réponse de B Hart, voici ma version d'une fonction qui recherche une valeur dans une plage et retourne toutes les plages (cellules) trouvées:
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
Pour rechercher une valeur dans l'ensemble du classeur:
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
Sur la base de la réponse d'Ahmed, après un certain nettoyage et généralisation, y compris les autres paramètres "Find", nous pouvons donc utiliser cette fonction dans n'importe quelle 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
Vous pouvez lire les données dans un tableau. De là, vous pouvez faire la correspondance en mémoire, au lieu de lire une cellule à la fois.
Le code ci-dessous évite de créer une boucle infinie. Supposons que XYZ est la chaîne que nous recherchons dans le classeur.
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
Dans mon scénario , je dois chercher la valeur dans la colonne A et avoir besoin de trouver les correspondances dans la colonne B. J'ai donc créé une boucle for, à l'intérieur elle recherchera toute la colonne A et obtenez la correspondance exacte de la colonne 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