Comment remplir une listbox avec une liste mais triée et sans doublons ?

Paritec

XLDnaute Barbatruc
Bonjour à tous,
je cherche à remplir une listbox avec une liste mais j'aimerais que cette liste soit sans doublons et triée si possible.
Remplir avec la liste en l'état pas de soucis mais triée et sans doublons je ne sais pas faire
merci d'avance de vos réponses
a+
papou :)
 

Pièces jointes

  • listbox triée.xls
    41.5 KB · Affichages: 205

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Re : Comment remplir une listbox avec une liste mais triée et sans doublons ?

Bonjour,

Méthode rapide (0,1 s pour 10.000 lignes):

Listes sans doublons triée

Code:
Private Sub UserForm_Initialize()
  Set f = Sheets("BD")
  Set MonDico = CreateObject("Scripting.Dictionary")
  For Each c In Range(f.[A2], f.[A65000].End(xlUp))
    If c.Value <> "" Then MonDico.Item(c.Value) = c.Value
  Next c 
  temp = MonDico.items
  Call Tri(temp, LBound(temp), UBound(temp))
  Me.ComboBox1.List = temp
End Sub

Sub Tri(a, gauc, droi) ' Quick sort
  ref = a((gauc + droi) \ 2)
  g = gauc: d = droi
  Do
     Do While a(g) < ref: g = g + 1: Loop
     Do While ref < a(d): d = d - 1: Loop
     If g <= d Then
        temp = a(g): a(g) = a(d): a(d) = temp
        g = g + 1: d = d - 1
     End If
   Loop While g <= d
   If g < droi Then Call Tri(a, g, droi)
   If gauc < d Then Call Tri(a, gauc, d)
End Sub

JB
 
Dernière édition:

mromain

XLDnaute Barbatruc
Re : Comment remplir une listbox avec une liste mais triée et sans doublons ?

Bonjour Paritec, BOISGONTIER,

voici une solution :
Code:
Dim myDico As Object, i As Long, j As Long, nbLignes As Long, tabStr As Variant, tmpStr As String

    Set myDico = CreateObject("Scripting.Dictionary")
    
    'enlever les doublons
    With ThisWorkbook.Sheets("Feuil1")
        nbLignes = .Range("B" & .Rows.Count).End(xlUp).Row
        On Error Resume Next
        For i = 2 To nbLignes
            myDico.Add .Range("B" & i).Text, .Range("B" & i).Text
        Next i
        On Error GoTo 0
    End With
    
    tabStr = myDico.Items
    
    'trier la liste
    For i = LBound(tabStr) To UBound(tabStr) - 1
        For j = i + 1 To UBound(tabStr)
            If tabStr(j) < tabStr(i) Then
                tmpStr = tabStr(j)
                tabStr(j) = tabStr(i)
                tabStr(i) = tmpStr
            End If
        Next j
    Next i
    
    'afficher la liste dans le controle
    Me.ListBox1.List = tabStr

a+
 

Lii

XLDnaute Impliqué
Re : Comment remplir une listbox avec une liste mais triée et sans doublons ?

Bon jour,

Une autre façon (avec Combobox et Listview). Le tri se fait comme dans une feuille (ordre alphabétique normal, pas basé sur les codes ASCII donc tenant compte des lettres accentuées s'il y en a).
Code:
Private Sub UserForm_Initialize()
Dim L As Long
  [COLOR="SeaGreen"] 'pour l'unicité[/COLOR]
  For L = 2 To [B65000].End(xlUp).Row
    ComboBox1 = Cells(L, 2)
    If ComboBox1.ListIndex = -1 Then ComboBox1.AddItem Cells(L, 2)
  Next
  [COLOR="SeaGreen"]'pour le tri[/COLOR]
    For L = 1 To ComboBox1.ListCount - 1
    If ComboBox1.List(L) <> "" Then ListView1.ListItems.Add , , ComboBox1.List(L)
    Next
    For L = 1 To ListView1.ListItems.Count
      ListBox1.AddItem ListView1.ListItems(L)
    Next
End Sub
 

Pièces jointes

  • listbox triée.zip
    12.9 KB · Affichages: 177

Lii

XLDnaute Impliqué
Re : Comment remplir une listbox avec une liste mais triée et sans doublons ?

Re,

Jacques, j'avais bien constaté ce gros désavantage mais, le choix se pose quand on a « zoé » et « zoo » par exemple dans la liste.
Une macro ultra rapide qui place le second avant le premier dans l’ordre alphabétique me gêne. Voilà le sens de ma réflexion.
 

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Re : Comment remplir une listbox avec une liste mais triée et sans doublons ?

Zoo est classé après Zoé.

Code:
Private Sub UserForm_Initialize()
  Set f = Sheets("BD")
  Set MonDico = CreateObject("Scripting.Dictionary")
  For Each c In Range(f.[A2], f.[A65000].End(xlUp))
   If c.Value <> "" Then MonDico.Item(c.Value) = c.Value
  Next c
  '--avec tri
  temp = MonDico.items
  Call Tri(temp, LBound(temp), UBound(temp))
  Me.ComboBox1.List = temp
End Sub

Sub Tri(a, gauc, droi)          ' Quick sort
 ref = a((gauc + droi) \ 2)
 g = gauc: d = droi
 Do
     Do While sansAccent(a(g)) < sansAccent(ref): g = g + 1: Loop
     Do While sansAccent(ref) < sansAccent(a(d)): d = d - 1: Loop
     If g <= d Then
       temp = a(g): a(g) = a(d): a(d) = temp
       g = g + 1: d = d - 1
     End If
 Loop While g <= d
 If g < droi Then Call Tri(a, g, droi)
 If gauc < d Then Call Tri(a, gauc, d)
End Sub

Function sansAccent(chaine)
   codeA = "ÉÈÊËÔéèêëàçùôûïî"
   codeB = "EEEEOeeeeacuouii"
   temp = chaine
   For i = 1 To Len(temp)
    p = InStr(codeA, Mid(temp, i, 1))
    If p > 0 Then Mid(temp, i, 1) = Mid(codeB, p, 1)
   Next
   sansAccent = temp
End Function

Marin est classé avec MARIN.

Code:
Sub Tri(a, gauc, droi)          ' Quick sort
 ref = a((gauc + droi) \ 2)
 g = gauc: d = droi
 Do
     Do While UCase(SansAccent(a(g))) < UCase(SansAccent(ref)): g = g + 1: Loop
     Do While UCase(SansAccent(ref)) < UCase(SansAccent(a(d))): d = d - 1: Loop
     If g <= d Then
       temp = a(g): a(g) = a(d): a(d) = temp
       g = g + 1: d = d - 1
     End If
 Loop While g <= d
 If g < droi Then Call Tri(a, g, droi)
 If gauc < d Then Call Tri(a, gauc, d)
End Sub


JB
 

Pièces jointes

  • ListeSansDoublonsDictionaireAccent.zip
    18 KB · Affichages: 135
  • ListeSansDoublonsDictionaireAccent2Col.zip
    19.1 KB · Affichages: 120
Dernière édition:

Discussions similaires

Réponses
18
Affichages
505

Statistiques des forums

Discussions
311 709
Messages
2 081 754
Membres
101 812
dernier inscrit
trufu