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

patricktoulon

XLDnaute Barbatruc
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


VB:
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
VB:
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 ;)
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
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

XLDnaute Barbatruc
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
VB:
Sub exemple_remplissage()
    [A1].Resize(Rows.Count).FormulaR1C1 = "= ADDRESS(ROW(),COLUMN())"
End Sub

pour windows(plus rapide que le dataobject)
VB:
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)
VB:
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!!!😁
 

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
311 725
Messages
2 081 942
Membres
101 849
dernier inscrit
florentMIG