comment faire un mouteur de recherche

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range 'déclare la variable cel (Cellule)
Dim lst As String 'déclare la variable lst (LiSTe de validation)

If Target.Address <> "$D$1" Then Exit Sub 'si le changement a lieu ailleurs qu'en D1, sort de la procédure

'***************************
'Liste de validation entière
'***************************
If Target.Value = "" Then 'condition : si D1 est effacée
    With Target.Offset(1, 0).Validation 'prend en compte la validation de donnée en D2
        .Delete 'supprime l'ancienne éventuelle validation de données
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=" & Range("liste").Address 'ajoute la plage nommée "liste" comme liste de validation
    End With 'fin de la prise en compte de la liste de validation en D2
    Exit Sub 'sort de la procédure
End If 'fin de la condition

'***************************************
'Liste de validation correspondante à D1
'***************************************
For Each cel In Range("liste") 'boucle sur toutes les cellule de la plage nommée "liste"
    'condition : si les premières lettres (converties en majuscules) de cel sont égales la valeur éditée en D1 (convertie en majuscule)
    If UCase(Left(cel.Value, Len(Target.Value))) = UCase(Target.Value) Then
        lst = IIf(lst = "", cel.Value & ",", lst & cel.Value & ",") 'définit la variable lst
    End If 'fin de la condition
Next cel 'prochaine cellule de la boucle
If lst = "" Then Exit Sub 'si lst est vide, sort de la procédure
With Target.Offset(1, 0).Validation 'prend en compte la validation de donnée en D2
    .Delete 'supprime l'ancienne éventuelle validation de données
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    xlBetween, Formula1:=lst 'ajoute la variable lst comme liste de validation
End With 'fin de la prise en compte de la liste de validation en D2
End Sub

Private test As Boolean 'déclare la variable test


Private Sub TextBox1_Change() 'au changement de la TextBox1
Dim pc As Byte 'déclare la variable pc (Position du Curseur)
Dim dl As Integer 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim r As Range 'déclare la variable r (Recherche)
Dim pa As String 'déclare la variable pa (Première Adresse)

If test = True Then Exit Sub 'si test est vrai, sort de la procédure
pc = Len(Me.TextBox1.Value) 'définit la position du curseur
Me.ListBox1.Clear 'vide la ListBox1
With Sheets("Feuil1") 'prend en compte l'onglet "Feuil1"
    dl = .Cells(Application.Rows.Count, 8).End(xlUp).Row 'définit la dernière ligne éditée dl de la colonne 8 (=H)
    Set pl = Range("H1:H" & dl) 'définit la plage pl
End With 'fin de la prise en compte de l'onglet "Feuil1"
Set r = pl.Find(Me.TextBox1.Value, , xlValues, xlPart) 'définit la recherche r (recherche le contenu de la TextBox1 dans la plage pl)
If Not r Is Nothing Then 'condition : si il existe au moins une occurrence trouvée
    pa = r.Address 'définit l'adresse de la première occurrence trouvée
    Do 'exécute
        If UCase(Left(r.Value, pc)) = UCase(Me.TextBox1.Value) Then 'condition 2 : si le texte éditée dans la TextBox1 correspond au début du texte de l'occurrence
            test = True 'définit la variable test (evite la boucle sur l'événement "Change" du bouton
            TextBox1.Value = r.Value 'modifie le texte édité dans la TextBox1
            'sélectionne le texte dans la TextBox1
            Me.TextBox1.SelStart = pc 'début de la sélection
            Me.TextBox1.SelLength = Len(Me.TextBox1) - pc 'longueur de la sélection
        End If 'fin de la condition 2
        Me.ListBox1.AddItem r.Value 'ajoute l'occurrence trouvée à la ListBox1
        Set r = pl.FindNext(r) 'redéfinit la recherche r (occurrence suivante)
    Loop While Not r Is Nothing And r.Address <> pa 'boucle tant qu'il existe de nouvelles occurrences ailleurs qu'en pa
End If 'fin de la condition 1
test = False 'réinitialise la variable test
End Sub


Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) 'au double-clic dans la ListBox1
Sheets("Feuil1").Range("C5").Value = Me.ListBox1.Value 'place en C5 le mot double-cliqué dans la ListBox1
Unload Me 'vide et ferme l'UserForm
End Sub


Private Sub CommandButton1_Click() 'bouton "Valider"
Sheets("Feuil1").Range("C5").Value = Me.TextBox1.Value 'place en C5 le mot dans la TextBox1
Unload Me 'vide et ferme l'UserForm
End Sub