XL 2010 Afficher 2 colonnes sans doublon dans listbox avec dictionnaire

[corloste]

Bonjour,

J'effectue une recherche à partir d'une saisie sur Textbox et l'affichage du résultat sur un Listbox. Pour cela j'utilise une macro qui utilise un dictionnaire.
Jusqu'à présent je n'avais besoin que d'une seule colonne sur le Listbox et le code fonctionnait très bien.

Private Sub TextBox1_Change()
Dim recherche As String, adresse As String
ListBox1.Clear

Set mondico = CreateObject("Scripting.Dictionary")
recherche = TextBox1.Value

'Recherche sur liste
With Sheets("Feuil2").Range("F4:F65000")
    Set c = .Find(recherche, lookat:=xlPart)
    If Not c Is Nothing Then
    adresse = c.Address
        Do
            If UCase(recherche) = UCase(recherche) Then
            mondico.Item(c.Value) = c.Value
            End If
           
            ListBox1.List = mondico.Items
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> adresse
    End If
End With
Set mondico = Nothing

End Sub

Mon fichier évoluant, j'ai besoin maintenant d'une deuxième colonne dans le Listbox qui va récupérer la valeur contenue dans la cellule située à X cellules à côté de l'Item.
Mon problème est que soit j'arrive à remplir les 2 colonnes correctement mais avec des doublons, soit je n'ai pas de doublon mais rien dans la deuxième colonne.

Exemple code avec les doublons :

Private Sub TextBox1_Change()
On Error Resume Next
ListBox1.ColumnWidths = "250;50"
ListBox1.ColumnCount = 2
'Séquence recherche
Dim recherche As String, adresse As String
ListBox1.Clear
Set mondico = CreateObject("Scripting.Dictionary")
recherche = TextBox1.Value

'Recherche sur liste
With Sheets("Feuil2").Range("F4:F65000")
    Set c = .Find(recherche, lookat:=xlPart)
    If Not c Is Nothing Then
    adresse = c.Address
        Do
            If UCase(recherche) = UCase(recherche) Then
            mondico.Item(c.Value) = c.Value
            End If
           
           
            ListBox1.AddItem c(ligne + 1, 1).Offset(0, 0)
            ListBox1.List(ListBox1.ListCount - 1, 1) = c.Offset(0, 17)
           
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> adresse
    End If
End With
End Sub

Pourriez-vous m'aider à trouver une solution pour garder ce système de recherche et remplir le Listbox sur 2 colonnes et sans doublon.

Merci.

 

[youky(BJ)]

Bonjour,
Je m'étonne de cette ligne....
If UCase(recherche) = UCase(recherche) Then
c'est forcement égale donc à remplacer par
If UCase(recherche) = UCase(c.value) Then
ensuite pour retrouver facilement la ligne de la listbox2 prévoir 1 colonne en plus pour y stocker la ligne
ListBox1.AddItem c(ligne + 1, 1).Offset(0, 0)
ListBox1.List(ListBox1.ListCount - 1, 1) = c.Offset(0, 17)
ListBox1.List(ListBox1.ListCount - 1, 2) = c.rows'penser à ajouter une colonne largeur= 0

Bruno

 

[corloste]

Merci pour cette correction.

Je pense que cela doit être une étape car j'ai toujours les doublons dans le Listbox.
Pour exemple, voici un fichier (avec des fruits, pourquoi pas). Lorsque je cherche "golden" il faudrait qu'une réponse correspondante et non toutes les réponses présentes dans le tableau.
De plus avec ce code lorsque on efface les caractères inscrits dans le Textbox (avec retour arrière) le code insère tous les Items vides dans le Listbox.

Cordialement

 

[gosselien]

Bonjour,

une très bonne aide ici en rubrique dictionnaire:
http://boisgontierjacques.free.fr/

P.

 

[youky(BJ)]

Voici avec ma façon de faire
La 1ere macro est si on click sur la list
Dés l'appui sur une touche la macro cherche dans chaque cellule si c'est présent
Donc pour trouver griotte on peux mettre tt et hop!
Bruno

Private Sub ListBox1_Click()
MsgBox "Ligne: " & ListBox1.List(ListBox1.ListIndex, 2)
End Sub

Private Sub TextBox1_Change()
If TextBox1 = "" Then ListBox1.Clear: Exit Sub
ListBox1.ColumnWidths = "150;50;0"
ListBox1.ColumnCount = 3
ListBox1.Clear
With Feuil2
  Set dico = CreateObject("Scripting.Dictionary")
For Each c In .Range(.[F2], .[F65000].End(xlUp))
    If c.Value Like "*" & TextBox1 & "*" Then
      If Not dico.Exists(c.Value) And c.Value <> "" Then
       dico.Add c.Value, c.Value:
        Feuil1.ListBox1.AddItem c.Value
        Feuil1.ListBox1.List(Feuil1.ListBox1.ListCount - 1, 1) = c.Offset(0, 17)
        Feuil1.ListBox1.List(Feuil1.ListBox1.ListCount - 1, 2) = c.Row
      End If
    End If
   Next c
End With
End Sub

je mets le fichier

 

[corloste]

Merci gosselien j'y avais été mais ce que j'ai trouvé ne s'adaptait pas avec la méthode .Find (ou je n'y suis pas arrivé).

 

[corloste]

Bravo et merci youky,

Ça fonctionne très bien, après tout je ne suis pas marié avec le .find.
Quelle est l'utilité de la 3ème colonne pour cette fonction de recherche ?

 

[youky(BJ)]

La 3ème colonne n'est là que pour stocker la valeur de la ligne trouvée et la récupérer si besoin d'aller modifier cette ligne.
Si tu ne t'en sert pas on peut supprimer du code. Je viens de faire ici et ajout de Ucase qui permets de tester les 2 données en majuscule.
Tu peux supprimer toute la macro Private Sub ListBox1_Click() qui n'est plus utile.
Bruno

Private Sub TextBox1_Change()
If TextBox1 = "" Then ListBox1.Clear: Exit Sub
ListBox1.ColumnCount = 2
ListBox1.ColumnWidths = "150;50"
Dim recherche As String, adresse As String
ListBox1.Clear
With Feuil2
  Set dico = CreateObject("Scripting.Dictionary")
For Each c In .Range(.[F2], .[F65000].End(xlUp))
    If UCase(c.Value) Like "*" & UCase(TextBox1) & "*" Then
      If Not dico.Exists(c.Value) And c.Value <> "" Then
       dico.Add c.Value, c.Value:
        Feuil1.ListBox1.AddItem c.Value
        Feuil1.ListBox1.List(Feuil1.ListBox1.ListCount - 1, 1) = c.Offset(0, 17)
      End If
    End If
   Next c
End With
End Sub

 

[BOISGONTIER]

Bonsoir,

http://boisgontierjacques.free.fr/pages_site/Dictionnaire.htm#Combo2col
http://boisgontierjacques.free.fr/f...rmCascadeSansDoublons2colonnesDictListBox.xls

JB

 

[youky(BJ)]

Voir si pour les majuscules si c'est mieux tout dépend....
Bruno

Private Sub TextBox1_Change()
If TextBox1 = "" Then ListBox1.Clear: Exit Sub
ListBox1.ColumnCount = 2
ListBox1.ColumnWidths = "150;50"
Dim recherche As String, adresse As String
ListBox1.Clear
With Feuil2
  Set dico = CreateObject("Scripting.Dictionary")
For Each c In .Range(.[F2], .[F65000].End(xlUp))
    If UCase(c.Value) Like "*" & UCase(TextBox1) & "*" Then
      If Not dico.Exists(UCase(c.Value)) And c.Value <> "" Then
       dico.Add UCase(c.Value), UCase(c.Value)
        Feuil1.ListBox1.AddItem c.Value
        Feuil1.ListBox1.List(Feuil1.ListBox1.ListCount - 1, 1) = c.Offset(0, 17)
      End If
    End If
   Next c
End With
End Sub

 

[corloste]

Pour les majuscules, je ne me suis pas embêté, j'ai ajouté "option compare text", cela me suffit, mais je garde volontiers cette solution s'il y a d'autres évolutions dans le futur.
J'ai ôté la 3ème colonne, mais l'idée de stocker une valeur sur une colonne de taille 0 (donc invisible) m'a permis une autre évolution.

Pour le code sur le site de Boisgontier, c'est bien celui que j'avais vu, mais comme je l'ai dit plus haut, je m'étais entêté à garder le .find

Encore merci à tous