Supprimer doublons d'une listbox à deux colonnes

[pumbathekings]

Bonjour,

Voici mon problème, lorsque je charge une configuration via la combobox, des sous-fonctions se collent dans une listbox (subfunctions). Lorsque je veux rajouter des sousfonctions, je fais mon drag N drop. d'autres sousfonctions vont alors s'ajouter à ma listbox subfunctions.

Le problème étant, je n'arrive pas à supprimer ces fameux doublons.



VOici mon code:

Public Sub Sup_doublons()
Dim i As Long
Dim j As Long

With Me.Subfunctions

For i = 0 To .ListCount - 1
For j = .ListCount To (i + 1) Step -1
If Subfunctions.Column(.List, i) = Subfunctions.Column(.List, j) Then
.RemoveItem

End If
Next j
Next i

End With
End Sub

Si quelqu'un avait une solution..
D'avance merci.

Pumba

 

[BOISGONTIER]

Re : Supprimer doublons d'une listbox à deux colonnes

Bonjour,

Exemple

Dim f
Private Sub UserForm_Initialize()
  Set f = Sheets("bd")
  Me.ListBox1.List = f.Range("A2:D" & f.[B65000].End(xlUp).Row).Value
  Set d = CreateObject("Scripting.Dictionary")
  j = 0
  Do While j < Me.ListBox1.ListCount
    tmp = ListBox1.List(j, 0) & ListBox1.List(j, 1)
    If Not d.exists(tmp) Then
      d(tmp) = ""
      j = j + 1
    Else
      Me.ListBox1.RemoveItem j
    End If
  Loop
End Sub

jb

 

[pumbathekings]

Re : Supprimer doublons d'une listbox à deux colonnes

Bonjour Jb,

Merci pour cet exemple. Cependant, je n'ai pas réussi à le rendre fonctionnel. Lorsque je lance ma macro, une erreur apparait.
Cela vient-il du code ou juste du fait que ma listbox ne soit pas triée (confère image dans sujet).

Ci-dessous mon code:

Private Sub Doublon2()
Dim j As Integer
Dim d As Object
Dim tmp As Variant
Set d = CreateObject("Scripting.Dictionary")
j = 0
Do While j < Me.ListBox1.ListCount
tmp = Subfunctions.List(j, 0) & Subfunctions.List(j, 1)
If Not d.exists(tmp) Then
d(tmp) = ""
j = j + 1
Else
Me.Subfunctions.RemoveItem j
End If
Loop
End Sub

La facon dont je l'insère :

Doublon2 Me.Subfunctions

D'avance merci.

Pumba