Discussion :

[Maxou 10]

Bonjour à tous,

J'ai un code qui me permet de charger ma combobox par ordre alphabétique.
Est-il possible d'enlever les doublons en plus ?

Voici mon code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Private Sub UserForm_Initialize()
    Dim plage As Integer, PlageTri As Integer
    Dim base As String
 
    Set ws = Sheets("Synthèse")
 
    With Me.ComboBoxSouhait1
        For plage = 5 To 40
        Text = ws.Cells(plage, 1)
            If Text <> "" And ws.Cells(plage, 4) > 0 Then
                .AddItem ws.Range("A" & plage)
            End If
        Next plage
    End With
 
        For plage = 0 To ComboBoxSouhait1.ListCount - 1
        For PlageTri = 0 To ComboBoxSouhait1.ListCount - 1
            If ComboBoxSouhait1.List(plage) < ComboBoxSouhait1.List(PlageTri) Then
                base = ComboBoxSouhait1.List(plage)
                ComboBoxSouhait1.List(plage) = ComboBoxSouhait1.List(PlageTri)
                ComboBoxSouhait1.List(PlageTri) = base
            End If
        Next PlageTri
        Next plage
 
End Sub

Merci pour votre aide.

[Jean-Philippe André]

Salut,

tu as deux moments pour faire ton test de doublon.

- soit lorsque tu alimentes ta combobox, en vérifiant que la valeur n,est pas déjà parmi celles de ta combobox

- soit une fois que tu as alimenté ta combobox, tu supprimes les items qui seraient déjà apparus

Ton avantage ici c'est que si tes données sont déjà dans le bon ordre, il suffit de comparer ta valeur i et i-1 en faisant une boucle décrémentée

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
For i = ComboBoxSouhait1.Count to 1 Step -1
    ' ton test de comparaison + suppression le cas échéant
Next i

[Franc]

Bonjour, voici une suggestion avec utilisation d'une Collection. Les doublons sont automatiquement gérés car une Collection ne peut pas avoir de clés dupliquées.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Private Sub UserForm_Initialize()
    Dim plage As Integer
    Dim base As String
    Dim ws As Worksheet
    Dim itemsCollection As Collection
    Dim item As Variant
    Dim i As Integer, j As Integer
    Dim temp As String
 
    Set ws = Sheets("Synthèse")
    Set itemsCollection = New Collection
 
    ' Gérer les erreurs pour ignorer les doublons
    On Error Resume Next
 
    ' Ajouter les valeurs uniques à la collection
    For plage = 5 To 40
        base = ws.Cells(plage, 1).Value
        If base <> "" And ws.Cells(plage, 4).Value > 0 Then
            itemsCollection.Add base, CStr(base)
        End If
    Next plage
 
    On Error GoTo 0
 
    For Each item In itemsCollection
        Me.ComboBoxSouhait1.AddItem item
    Next item
 
    For i = 0 To Me.ComboBoxSouhait1.ListCount - 2
        For j = i + 1 To Me.ComboBoxSouhait1.ListCount - 1
            If Me.ComboBoxSouhait1.List(i) > Me.ComboBoxSouhait1.List(j) Then
                temp = Me.ComboBoxSouhait1.List(i)
                Me.ComboBoxSouhait1.List(i) = Me.ComboBoxSouhait1.List(j)
                Me.ComboBoxSouhait1.List(j) = temp
            End If
        Next j
    Next i
End Sub

[Maxou 10]

Merci pour vos réponse, une fois de plus vous avez assuré.

Je n'ai pas réussi avec .count mais la collection, c'est nickel.

Encore merci pour votre aide.

[modus57]

Bonjour @ tous,

Vaut mieux tard que jamais, voici une autre solution :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
    Dim i As Long, j As Long
    With Me.ListBox1
        For i = 0 To .ListCount - 1
            For j = .ListCount - 1 To (i + 1) Step -1
                If .List(j) = .List(i) Then
                    .RemoveItem j
                End If
            Next
        Next
    End With

[deedolith]

Hello,

Bonjour @ tous,

Vaut mieux tard que jamais, voici une autre solution :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
    Dim i As Long, j As Long
    With Me.ListBox1
        For i = 0 To .ListCount - 1
            For j = .ListCount - 1 To (i + 1) Step -1
                If .List(j) = .List(i) Then
                    .RemoveItem j
                End If
            Next
        Next
    End With

La collection est plus performante et le code est plus simple (une seule boucle),
De plus, si le besoin de respecter la casse se fait sentir, on peut passer par un dictionnaire (Scripting.Dictionary).

[modus57]

Bonjour deedolith,

Effectivement avec un ComboBox si la quantité de données est très importantes la collection est plus performante.

Ma solution fonctionne aussi avec une ListBox multicolonne, mais je n’ai pas testé avec une importantes source de données.

[modus57]

Bonsoir,

Voici une solution avec un dictionnaire et choix de la colonne qui devra supprimer les doublons dans une ListBox multicolonne.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Dim f
Private Sub UserForm_Initialize()
    Me.ListBox1.ColumnCount = 5
    Me.ListBox1.ColumnWidths = ("40;40;40;40;50")
    Me.ListBox1.List = Range("Tableau3").Value
    Set d = CreateObject("Scripting.Dictionary")
    J = 0
    Do While J < Me.ListBox1.ListCount
        'tmp = ListBox1.List(J, 0)  'supprime doublons colonne 1
        'tmp = ListBox1.List(J, 1)  'supprime doublons colonne 2
        tmp = ListBox1.List(J, 2)  'supprime doublons colonne 3
        'tmp = ListBox1.List(J, 3)  'supprime doublons colonne 4
        'tmp = ListBox1.List(J, 4)  'supprime doublons colonne 5
        If Not d.exists(tmp) Then
            d(tmp) = ""
            J = J + 1
        Else
            Me.ListBox1.RemoveItem J
        End If
    Loop
End Sub

Tester avec un tableau structuré + de 3000 lignes c'est quasiment instantané.

[Thumb down]

Bonjour,
je n'es pas testé sur un grande quantité de données.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
Sub AjouterDichotomique(Combo As ComboBox, Element As String)
    Dim Bas As Long, Haut As Long, Milieu As Long
    Dim Position As Long
 
    Bas = 0
    Haut = Combo.ListCount - 1
    Position = -1 ' Par défaut, ajoute à la fin
 
 
    ' Recherche dichotomique
    Do While Bas <= Haut
        Milieu = (Bas + Haut) \ 2
        If StrComp(Combo.List(Milieu), Element, vbTextCompare) > 0 Then
            Haut = Milieu - 1
        ElseIf StrComp(Combo.List(Milieu), Element, vbTextCompare) < 0 Then
            Bas = Milieu + 1
        Else
            Position = Milieu ' Trouvé, évite les doublons
            Exit Do
        End If
    Loop
 
 
    ' Si l'élément n'existe pas, insérer à la bonne position
    If Position = -1 Then
        Position = Bas
        Combo.AddItem Element, Position
    End If
End Sub
 
 
' Exemple d'utilisation
Sub TestAjouterDichotomique()
    Dim Combo As ComboBox
    Set Combo = UserForm1.ComboBox1 ' Remplacez par votre formulaire/contrôle
 
 
    ' Ajouter des éléments de façon dichotomique
    AjouterDichotomique ComboBox1, "Banane"
    AjouterDichotomique ComboBox1, "Orange"
    AjouterDichotomique ComboBox1, "Pomme"
    AjouterDichotomique ComboBox1, "Cerise"
 
End Sub
 
 
 
 
Private Sub UserForm_Initialize()
TestAjouterDichotomique
End Sub