Creation d'une listbox sans doublons

Version imprimable

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:

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

25/07/2017, 11h18
Philippe Tulliez

Bonjour,

Citation:

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é

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:

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

25/07/2017, 14h07
Babar09

Merci à tous les deux, fuine0069, j'ai essayé ta methode mais elle ne fonctionne pas, mes elements apparaissent toujours plusieurs fois...
25/07/2017, 14h22
Philippe Tulliez

Bonjour,

Citation:

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

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:

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:

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

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

1 pièce(s) jointe(s)

Bonjour,

La méthode la + rapide en PJ

Code:

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

02/08/2017, 15h21
Babar09

Désolé pour cette réponse tardive, merci à tous pour votre aide :)