listbox et combobox (une ou multi colonne) ou sans doublons sans dico sans collection

[patricktoulon]

Bonjour à tous
le sujet reviens souvent
a savoir remplir une combobox ou listbox sans doublons
je vous propose ma méthode (je l'ai déjà donné sur le forum plusieurs fois )
cette méthode consiste a tester l'index que donne match dans une simple boucle sur l'array
exemple 1:
remplir une (combobox ou listbox) avec un array en base zero

Private Sub UserForm_Activate()
    Dim T
    T = Array("toto", "titi", "riri", "fifi", "loulou", "machin", "toto", "truc", "bidule", "titi", "robert", "riri", "fifi", "paul", "loulou")
    ListUniqueWithArray T, ComboBox1
End Sub
Sub ListUniqueWithArray(T, ObjList)
    Dim z&, I&, X&
    If LBound(T) = 0 Then z = 1
    For I = LBound(T) To UBound(T)
        X = Application.Match(T(I), T, 0) - z: If X = I Then ObjList.AddItem T(I)
    Next
End Sub

--------------------------------------------------------------------
exemple 2:
remplir une (combobox ou listbox) avec une plage (1 ou plusieurs colonnes) en supprimant les doublons dans une colonne precise
dans cet exemple je supprime les doublons dans la colonne 1( index 0 de la combobox ou listbox)
pour cela j'utilise un array issu du tableau avec application.index pour l'utilisation de match

Private Sub UserForm_Activate()
    Dim T
    T = Feuil1.Range([A1], Feuil1.[B65000].End(xlUp)).Value
    ComboBox1.ColumnCount = UBound(T, 2)
    ListUniquebyCol T, ComboBox1, 1
End Sub

Sub ListUniquebyCol(T, ObjList, Optional colonne As Long = 1)
    Dim Tx, I&, X&, Z&
    Tx = Application.Transpose(Application.Index(T, 0, colonne))
    If LBound(T) = 0 Then Z = 1
    For I = LBound(Tx) To UBound(Tx)
        X = Application.Match(Tx(I), Tx, 0) - Z
        If X = I Then
            ObjList.AddItem "": For c = LBound(T, 2) To UBound(T, 2): ObjList.List(ObjList.ListCount - 1, c - 1) = T(I, c): Next
        End If
    Next
End Sub

voila des codes tout simple valables aussi pour MAC et sans librairie externes
Bonne utilisation

 

[Staple1600]

Bonsoir patricktoulon

Quid si j'ai tout plein, tout plein, tout plein tout plein...
de cases dans ma colonne? Au hasard, 66 666 par exemple ?
Dans ce cas, je ferais ceci
T = Feuil1.Range([A1], Feuil1.Cells(Rows.Count,2).End(xlUp)).Value
Et normalement Excel va tousser, non ?
La fameuse limitation de Transpose
Sinon, c'est les MAC qui vont être contents

 

[patricktoulon]

re
bonsoir @Staple1600
oui la limite de transpose pose problème,en même temps une combo ou listbox de 65535 lignes faut pas pousser

cela dit,tu sais très bien que j'ai toujours une astuce pour transposer un tableau plus grands

bon ça sort des sentiers battus, c'est pour ça que je ne l'ai pas donné

mais si tu y tiens juste pour le fun


remplie la colonne en entier

Sub exemple_remplissage()
    [A1].Resize(Rows.Count).FormulaR1C1 = "= ADDRESS(ROW(),COLUMN())"
End Sub

pour windows(plus rapide que le dataobject)

Sub testtabloWindows()
    [A1].Resize(Rows.Count).Copy
    tablo = Split(CreateObject("htmlfile").parentwindow.clipboardData.GetData("TEXT"), vbCrLf)
    MsgBox UBound(tablo)
    Debug.Print Join(tablo, ",")
End Sub

pour MAC (moins rapide avec le dataobject mais valable aussi pour windows)

Sub testtabloMAC()
    [A1].Resize(Rows.Count).Copy
    With New DataObject: .GetFromClipboard: tablo = Split(.GetText(1), vbCrLf): End With
    MsgBox UBound(tablo)
    Debug.Print Join(tablo, ",")
End Sub

LOL!!!