VBA - Recherche Find avec retour multiple

Une simple recherche Find vous retourne la première coordonnée trouvée.
Dans certaines circonstances il est nécessaire de connaître toutes les coordonnées des occurrences trouvées.
C'est ce que fait cette petite fonction.

Dans un module public

'Retourne toutes les adresses trouvées dans la recherche
'WkbN = nom du classeur, avec cette donnée la fonction peut être mise dans un xla
'WksN = nom de la feuille
'Plage = les coordonnées de la plage à parcourir.
'Retour dans le tableau donner en argument.
Function RechFind(ByVal Cle As String, ByVal WkbN As String, ByVal WksN As String, ByVal Plage As String, ByRef TBadress() As Variant) As Long
Dim Cherche, Ix As Long, PrAddress
    With Workbooks(WkbN).Sheets(WksN).Range(Plage)
        Set Cherche = .Find(Cle)
        If Not Cherche Is Nothing Then
            PrAddress = Cherche.Address
            Do
                ReDim Preserve TBadress(Ix)
                TBadress(Ix) = Cherche.Address
                Set Cherche = .FindNext(Cherche)
                Ix = Ix + 1
            Loop While Not Cherche Is Nothing And Cherche.Address <> PrAddress
        End If
    End With
    'nombre d'occurence(s) trouvée(s), Retour 0 si aucune occurence
    RechFind = Ix
    Set Cherche = Nothing 'Libére la mémoire occupée par l'objet.
End Function

Le corps de la fonction est séparé pour éventuellement être mis dans un classeur Xla.

Exemple d'appel par macro

Peu être mis dans un module du classeur "appelant"

Sub RechMulti()
Dim R As Long, TB()
Dim i As Integer
    R = RechFind("12*", ThisWorkbook.Name, "Feuil1", "B1:B500", TB())
    If R > 0 Then
        For i = 0 To R - 1 ' ou ubound(TB)
            'exemple
            Sheets("Feuil1").Cells(i + 4, 5) = Range(TB(i)).Row
        Next i
    End If
End Sub

Exemple d'appel par bouton

Private Sub CommandButton1_Click()
Dim R As Long, TB()
Dim i As Integer
    Range("E4:E20").ClearContents
    R = RechFind(Range("E2"), ThisWorkbook.Name, ActiveSheet.Name, Range("B1:B500").Address, TB())
    If R > 0 Then
        For i = 0 To R - 1 ' ou ubound(TB)
            'exemple
            Sheets("Feuil1").Cells(i + 4, 5) = Range(TB(i)).Row
        Next i
    End If
End Sub

Télécharger

Si vous souhaitez un exemple concret Vous pouvez télécharger le classeur exemple Ce document intitulé « VBA - Recherche Find avec retour multiple » issu de CommentCaMarche (www.commentcamarche.net) est mis à disposition sous les termes de la licence Creative Commons. Vous pouvez copier, modifier des copies de cette page, dans les conditions fixées par la licence, tant que cette note apparaît clairement.