Filtrer avec Listbox et contrôle unicité

[corloste]

Bonjour,

J'utilise une macro que l'on m'avait indiqué sur ce forum, et je l'ai adapté à mon nouveau besoin :

Private Sub TextBox1_Change()
Dim Recherche As String, Adresse As String

ListBox1.Clear

Recherche = TextBox1.Value

'Recherche 1ere feuille'
With Sheets("Feuil2").Range("j2:j36000, k2:k36000, l2:l36000")
    Set C = .Find(Recherche, Lookat:=xlPart)
    If Not C Is Nothing Then
Adresse = C.Address
Do
    If UCase(Recherche) = UCase(Recherche) Then ListBox1.AddItem C
    Set C = .FindNext(C)
    Loop While Not C Is Nothing And C.Address <> Adresse
End If
End With

'Recherche 2eme feuille'
With Sheets("Feuil3").Range("d2:d30, f2:f30")
    Set C = .Find(Recherche, Lookat:=xlPart)
    If Not C Is Nothing Then
Adresse = C.Address
Do
    If UCase(Recherche) = UCase(Recherche) Then ListBox1.AddItem C
    Set C = .FindNext(C)
    Loop While Not C Is Nothing And C.Address <> Adresse
End If
End With

End Sub

Cette macro effectue une recherche sur 5 colonnes réparties sur 2 feuilles et reporte les résultats dans la listbox1.
Ce code fonctionne super bien, mais voilà le problème que je rencontre :
Quand plusieurs résultats strictement identiques sont trouvés dans les colonnes, ils sont quand même tous notés dans la listbox1.

Serait-il possible d'adapter ce code, pour qu'avec le même fonctionnement, si la recherche match sur des résultats identiques (qu'ils soient sur une feuille ou sur l'autre ou sur les 2) il ne soient inscrits qu'une seule fois dans la listbox1 ?

Merci pour votre aide.

PS : Je joints un fichier pour l'exemple d'utilisation, le code est un peu différent car il ne recherche que sur 4 colonnes, mais autrement c'est le même fonctionnement.

 

[CHALET53]

Re : Filtrer avec Listbox et contrôle unicité

bonjour,

Peut-être comme ceci

a+

 

[corloste]

Re : Filtrer avec Listbox et contrôle unicité

Bonsoir,

Et bien c'est un pile poil, merci beaucoup CHALET53. Je n'hésiterai pas à revenir si je suis à nouveau bloqué dans mon projet.

Cordialement