Supprimer doublons d'une listbox à deux colonnes

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

pumbathekings

XLDnaute Junior
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.

d.png

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
 

Pièces jointes

Re : Supprimer doublons d'une listbox à deux colonnes

Bonjour,

Exemple

Code:
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
 

Pièces jointes

Dernière édition:
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
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
10
Affichages
284
Réponses
4
Affichages
187
Réponses
10
Affichages
799
Réponses
5
Affichages
185
  • Question Question
Microsoft 365 Export données
Réponses
4
Affichages
652
Réponses
3
Affichages
670
Retour