Discussion :

[Babar09]

Bonjour à tous,

J'ai créé une ListBox dans laquelle plusieurs éléments se répètent, j'aimerais ne pas avoir de doublons dans cette ListBox. J'ai cherché un peu partout, mais je ne trouve rien de très simple. J'ai aussi tenté "If PlotForm.TimeList.ListIndex = -1 Then" mais cela ne fonctionne pas... Voici le morceau de code en question:

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
Dim i As Long
    Dim j As Long
    Dim Cell As Range
    Dim strTemp As String
 
    Sheets(LoggerParamChoiceTrends.ChoiceList.Text).Activate
 
    With ActiveSheet
        For Each Cell In Range([B10], [B10].End(xlToRight))
            Cell.Activate
            LoggerParamChoiceTrends.LoggerChoice.AddItem Split(Cell.Value, "@")(1)
        Next Cell
    End With
 
    'Sorts choices with alphabetical order
        With LoggerParamChoiceTrends.LoggerChoice
            For i = 0 To .ListCount - 1
                For j = 0 To .ListCount - 1
                    If .List(i) < .List(j) Then
                        strTemp = .List(i)
                        .List(i) = .List(j)
                        .List(j) = strTemp
                    End If
                Next j
            Next i
        End With
 
    Application.Goto Range("A1"), True

Si quelqu'un peut m'éclairer, je suis preneur pour toute idée

[Philippe Tulliez]

Bonjour,

J'ai cherché un peu partout, mais je ne trouve rien de très simple

Tu n'as pas bien cherché alors
Un exemple dans le chapitre II-G. ListBox du tutoriel Utiliser les contrôles dans un UserForm, en VBA Excel
et une fonction "clé sur porte" dans ce blog Initialiser un ComboBox sans doublons et trié

[fuine0069]

Hello,

Silkyroad avait déjà fait étape sur les list box, il y a aussi ajouté un élément pouvant limiter les doublons,
ci dessous l'extrait de son code que tu peux adapter au tien.

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 Cell As Range
    Dim Unique As New Collection
    Dim Valeur As Range
    Dim i As Integer
 
    'Récupère la derniere ligne non vide dans la colonne A
    i = Range("A65536").End(xlUp).Row
 
    On Error Resume Next
    'boucle sur les cellules de la colonne A
    For Each Cell In Range("A1:A" & i)
        'Stocke les données dans une collection
        '(La collection n'accepte que des données uniques et permet donc
        ' de filtrer facilement les doublons).
        Unique.Add Cell, CStr(Cell)
    Next Cell
    On Error GoTo 0
 
    'Boucle sur le contenu de la collection pour alimenter la ListBox
    For Each Valeur In Unique
        Me.ListBox1.AddItem Valeur
    Next Valeur
End Sub

[Babar09]

Merci à tous les deux, fuine0069, j'ai essayé ta methode mais elle ne fonctionne pas, mes elements apparaissent toujours plusieurs fois...

[Philippe Tulliez]

Bonjour,

fuine0069, j'ai essayé ta methode mais elle ne fonctionne pas, mes elements apparaissent toujours plusieurs fois...

Et bien tu devrais revoir ta copie car ce code fonctionne parfaitement

[patricktoulon]

bonsoir il y a aussi le dictionnaire
de deux facon
soit par le test de l'existence dans celui ci puis integration dans la listbox dans la meme boucle

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Private Sub UserForm_Initialize()
    Dim Cell As Range
    Dim Unique As Object
    Set Unique = CreateObject("scripting.dictionary")
     For Each Cell In Range("A1:A" & Range("A65536").End(xlUp).Row)
        If Not Unique.exists(Cell.Value) Then
            Unique(Cell.Value) = ""
            ListBox1.AddItem Cell.Value
        End If
    Next Cell
End Sub

soit on laisse le flux faire tout seul
en effet comme la collection le dictionnaire ne prends pas les doublons
on rempli donc le dictionnaire comme avec la collection puis on injecte les cles dans la listbox (unique.keys)
nul besoins de cocher la référence c'est en late binding pour les deux versions

Code :

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

1
2
3
4
5
6
7
8
9
10
private Sub UserForm_Initialize()
    Dim Cell As Range
    Dim Unique As Object
    Set Unique = CreateObject("scripting.dictionary")
    On Error Resume Next
    For Each Cell In Range("A1:A" & Range("A65536").End(xlUp).Row)
        Unique(Cell.Value) = ""
    Next Cell
    ListBox1.List = Unique.keys
End Sub

et maintenant juste pour rire parceque c'est bon pour la santé
imaginons que nous travaillons avec excel version Vercingétorix
que nous n'avons pas d'object(collection,dictionnaires etc...)
alors on créé nous même le testeur

mais c'est juste pour rire hein

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
Dim texte
Private Sub UserForm_Initialize()
    Dim Cell As Range
      For Each Cell In Range("A1:A" & Range("A65536").End(xlUp).Row)
        If Not ceci_existe_deja(Cell.Value) Then
                      ListBox1.AddItem Cell.Value
        End If
    Next Cell
End Sub
 
Function ceci_existe_deja(valeur As String) As Boolean
If texte Like "*" & valeur & ",*" Then
ceci_existe_deja = True
Else
texte = texte & valeur & ","
ceci_existe_deja = False
End If
End Function

j'ai bu un peu trop de Perrier moi c'est fou

[boisgontierjacques]

Bonjour,

La méthode la + rapide en PJ

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
Private Sub UserForm_Initialize()
  Set f = Sheets("BD")
  Set mondico = CreateObject("Scripting.Dictionary")
  a = f.Range("A2:A" & f.[A65000].End(xlUp).Row)  ' tableau a(n,1) pour rapidité
  For i = LBound(a) To UBound(a)
   If a(i, 1) <> "" Then mondico(a(i, 1)) = ""
  Next i
  Me.ComboBox1.List = MonDico.keys
  '--avec tri
  'temp = mondico.keys
  'Tri temp, LBound(temp), UBound(temp)
  'Me.ComboBox1.List = temp
End Sub

Boisgontier
http://boisgontierjacques.free.fr