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

Exemple d'appel par macro

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