Supprimer les doublons dans une list box

Bonjour à tous,

Je viens demander de l'aide car je ne sais pas comment procéder.

J'ai crée une userform avec 1 textbox, 1 listbox et un bouton.

• textbox1 est l'intitulé de ma recherche
• listbox1 est le résultat de ma recherche
• le bouton sert à lancer la recherche

Je recherche dans la colonne "I" d'une feuille de calcul un mot clé (que je rentre dans la textbox1) et le nom figurant dans la colonne "A" de la meme ligne s'inscrit dans la listbox1. Ca marche correctement mais

la listbox1 m'affiche des doublons et je souhaiterais les supprimer, j'ai essayer plusieurs codes trouvés ça et là mais ça ne marche pas et je n'arrive pas les adapter.

Si quelqu'un peut m'aider, merci d'avance.

Private Sub CommandButton1_Click()

Dim Nbre As Integer, Ref As String

Dim Ligne As Integer, Cptr As Integer

Sheets("Ma Cave").Activate

'efface le contenu de la listbox1'

ListBox1.Clear

'recherche dans la colonne I'

Ref = Me.TextBox1.Text

With Sheets("Ma Cave")

Nbre = Application.CountIf(Columns("I"), "*" & Ref & "*")

If Nbre > 0 Then

Ligne = 1

For Cptr = 1 To Nbre

Ligne = .Columns("I").Cells.Find(What:=Ref, after:=.Cells(Ligne, "I"), lookat:=xlPart).Row

ListBox1.AddItem .Cells(Ligne, "A")

Next

'si pas de résultat'

Else

MsgBox "pas trouvé", vbCritical

End If

End With

End Sub

Bonsoir

Un essai avec l'objet Dictionary

Private Sub CommandButton1_Click()
Dim Cel As Range, Depart As String, Ref As String
Dim Mondico As Object

  'efface le contenu de la listbox1'
  Me.ListBox1.Clear

  'recherche dans la colonne I'
  Ref = Me.TextBox1.Text

  ' Object qui n'accepte pas les doublons
  Set Mondico = CreateObject("Scripting.dictionary")

  With Sheets("Ma Cave")
    Set Cel = .Columns("I").Cells.Find(What:=Ref, LookIn:=xlValues, lookat:=xlPart)
    If Not Cel Is Nothing Then
      Depart = Cel.Address
      Do
        Mondico(Range("A" & Cel.Row).Value) = ""
        Set Cel = .Columns("I").Cells.FindNext(Cel)
      Loop While Depart <> Cel.Address
      Me.ListBox1.List = Application.Transpose(Mondico.keys)
    Else
      MsgBox "pas trouvé", vbCritical
    End If
  End With
End Sub

Merci pour ta réponse mais ça ne marche pas et je ne comprends rien. J'ai pas le niveau de pratique necessaire pour décripter.

J'ai déjà essayé l'objet dictionary et j'ai calé.

Bonsoir

Chez moi les tests on été concluants

Quand tu marques "ça ne marche pas", message d'erreur ?

Ton fichier est souhaitable

Erreur d'execution 1004 "la methode range de l'objet global a échoué"

et il surligne :

Mondico(Range("A" & Cel.Row).Value) = ""

De plus j'ai lu quelque part que lorsque l'on utilise l'objet "Scripting.dictionary" il fallait cocher "microsoft scripting runtime" dans la barre de menu outils, reference ?

Bonjour

Refais un test en mettant un . (point) devant le Range("A" & Cel.Row).Value) = ""

Mondico(.Range("A" & Cel.Row).Value) = ""

Merci Banzai, ça marche comme je veux, j'ai pas encore tout compris mais j'y travaille