Listes sans doublons triée pour ComboBox ou ListBox

Accueil

Liste sans doublons avec Dictionary
Listes sans doublons 2 colonnes
Liste sans doublons avec Dictionary trié
Fonction sansdoublonstrié
Liste triée avec accent
Majuscule / Minuscule
Filtre élaboré
Liste sans doublons avec ADO

Liste sans doublons

La liste est dans la colonne A et contient des doublons. Pour obtenir une liste sans doublons dans le combobox, on vérifie si l'élément existe déjà dans le combobox avant de l'ajouter (3,5sec pour 5.000 éléments).Attention! active l'événement Change().

Private Sub UserForm_Initialize()
  For i = 1 To Sheets(1).[A65000].End(xlUp).Row
      Me.ComboBox1 = Sheets(1).Cells(i, "A")        ' on se positionne dans le combobox
      If Me.ComboBox1.ListIndex = -1 Then           ' Existe t-il?
         Me.ComboBox1.AddItem Sheets(1).Cells(i, "A")
      End If
   Next i
End Sub

Liste sans doublons avec Dictionnary

On veut une liste déroulante sans doublons (0,15 sec pour 5.000 éléments).

Liste Sans Doublons
Combobox Numérique Sans doublons Trié
ListeSansDoublonsAccent.xls
ListeSansDoublonsAccentNbItems.xls

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
End Sub

Version liste triée

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
  '--avec tri
  temp = mondico.keys
  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

Sur MAC, Dictionary n'existe pas. Pour obtenir une liste sans doublons triée rapide:

FormLSDMAC

Option Compare Text
Dim f
Private Sub UserForm_Initialize()
  Set f = Sheets("base")
  Dim a()
  a = Application.Transpose(f.Range("A2:A" & f.[A65000].End(xlUp).Row).Value)
  Me.ComboBox1.List = SansDoublonsTriéMAC(a())
End Sub

Function SansDoublonsTriéMAC(a())
  Call Tri(a, LBound(a), UBound(a))
  Dim b(): ReDim b(1 To UBound(a))
  i = 1: j = 0
  Do While i <= UBound(a)
    j = j + 1: b(j) = a(i)
    Do While a(i) = b(j)
       i = i + 1: If i > UBound(a) Then Exit Do
    Loop
  Loop
  ReDim Preserve b(1 To j)
  SansDoublonsTriéMAC = Application.Transpose(b)
End Function

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

Fonction SansDoublonsTrié()

Avec une fonction SansDoublonsTrié(), l'alimentation d'un combobox devient

Sans doublons trié

Private Sub UserForm_Initialize()
  Me.ComboBox1.List = SansDoublonsTrié(Application.Transpose(Range("A2:A" &      [A65000].End(xlUp).Row)))
End Sub

Function SansDoublonsTrié(a)
  Set d = CreateObject("Scripting.Dictionary")
  For Each c In a
    d(c) = ""
  Next c
  b = d.keys
  Call Tri(b, LBound(b), UBound(b))
  SansDoublonsTrié = Application.Transpose(b)
End Function

Listes sans doublons avec 2 colonnes (Nom+prénom)

FormCascadeSansDoublons2colonnesDict
Form Cascade Sans Doublons 2 colonnes Trié
Form Cascade Sans Doublons 2 colonnes Disjointes Trié
FormCascadeSansDoublons2colonnesMAC


Dim f, a()
Private Sub UserForm_Initialize()
  Set f = Sheets("bd")
  a = f.Range("A2:D" & f.[B65000].End(xlUp).Row).Value
  Set d = CreateObject("Scripting.Dictionary")
  Dim Tbl(1 To 2)
  For i = 1 To UBound(a)
   Tbl(1) = a(i, 1)
   Tbl(2) = a(i, 2)
   d(a(i, 1) & a(i, 2)) = Tbl
  Next i
  Dim b(): ReDim b(1 To 2, 1 To d.Count)
  i = 0
  For Each c In d.keys
    i = i + 1
    b(1, i) = d(c)(1)
    b(2, i) = d(c)(2)
  Next c
  Dim temp()
  temp = Application.Transpose(b)
  Call Tri(temp(), 1, LBound(temp), UBound(temp))
  Me.ComboBox1.List = temp
End Sub

Pour que le tri soit indépendant des majuscules/minuscules

Marin est classé avec MARIN.

OPTION COMPARE TEXT dans un module

Liste sans doublons triée (Filtre élaboré)

ListeTrieeFiltre.xls

La liste en colonne C est modifiée à chaque modif en colonne A

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Column = 1 And Target.Count = 1 Then
    Application.EnableEvents = False
    [A1:A1000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:= _
       Sheets("ListeSansDoublonsTriéFiltre").[c1], Unique:=True
    [C2:c100].Sort Key1:=Range("c2")
    Application.EnableEvents = True
  End If
End Sub-

La propriété RowSource du comboBox contient le nom de champ dynamique(Maliste2)

ou sans nom de champ dynamique

Me.ComboBox1.RowSource = "C2:C" & [C65000].End(xlUp).Row

Liste sans doublons triée (sans liste intermédiaire)

On tri d’abord la BD

Private Sub UserForm_Initialize()
   Dim temp()
   ReDim temp(100)
   Sheets("ListeSansDoublonsTrié3").[a2:A1000].Sort Key1:=[a2]
   i = 0
   For Each c In Range([a2], [a65000].End(xlUp))
     If IsError(Application.Match(c, temp, 0)) Then
       temp(i) = c
       i = i + 1
     End If
   Next c
   ReDim Preserve temp(i - 1)
   Me.ComboBox1.List = temp
End Sub

Liste sans doublons triée avec Collection - tri dans le tableur -

Private Sub UserForm_Initialize()
  Dim temp As New Collection
  [a2:A1000].Sort Key1:=[a2]
  On Error Resume Next
  For Each c In Range([a2], [A65000].End(xlUp))
    temp.Add Item:=c, key:=CStr(c)
  Next c
  On Error GoTo 0
  For Each i In temp
     Me.ComboBox1.AddItem i
  Next i
End Sub

Liste sans doublons triée avec Collection - tri dans un tableau -

(0,9 s pour 10.000 éléments)

Private Sub UserForm_Initialize()
   Dim TempCol As New Collection
   On Error Resume Next
   For Each c In Range([A2], [A65000].End(xlUp))
     TempCol.Add Item:=c, key:=CStr(c)
   Next c
   On Error GoTo 0
   '-- transfert dans un tableau
   Dim TempTab()
   ReDim TempTab(1 To TempCol.Count)
   For i = 1 To TempCol.Count
     TempTab(i) = TempCol(i)
   Next
   Call Tri(TempTab, 1, UBound(TempTab, 1))
   Me.ComboBox1.List = TempTab
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

Liste sans doublons triée avec ADO

Nom de champ MaListe= $A$1:$A$18

Private Sub UserForm_Initialize()
  ' dans Outils/Références cocher
  ' Microsoft ActivexDataObject 2.8 Library
  ChDir ActiveWorkbook.Path
  Dim rs As ADODB.Recordset
  Set cnn = New ADODB.Connection
  cnn.Open "DRIVER={Microsoft Excel Driver (*.xls)};DBQ=FormComboboxSansDoublons.XLS"
  Set rs = cnn.Execute("SELECT service FROM MaListe GROUP BY Service")
  Do While Not rs.EOF
     Me.Choix.AddItem rs("Service")
     rs.MoveNext
  Loop
  rs.Close
  cnn.Close
  Set rs = Nothing
  Set cnn = Nothing
End Sub

 

 

 

 

 

 

 

 

 

 

 

 


Exemples

Liste Triee Filtre
Liste Sans Doublons