Tri croissant ListBox

Résolu/Fermé
sygmajf99 Messages postés 14 Date d'inscription lundi 10 janvier 2011 Statut Membre Dernière intervention 6 juillet 2012 - 12 avril 2011 à 16:15
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 - 13 avril 2011 à 09:38
Bonjour,

J'aimerais faire un tri croissant dans mon listbox. Comment faire ? Voici mon code actuel :

Sub UserForm_Initialize()

Set f = Sheets("Rép-Questions Comité")
Set mondico = CreateObject("Scripting.Dictionary")
For k = 5 To f.[C5000].End(xlUp).Row
mondico(f.Cells(k, 3).Value) = f.Cells(k, 3).Value
Next k
Me.choix.List = mondico.items
Me.choix.MultiSelect = fmMultiSelectMulti

End Sub

MERCI !!!

2 réponses

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
Modifié par michel_m le 13/04/2011 à 10:01
Bonjour sygmajf, gbinforme

Une alternative (je n'ai pas compris l'utilité d'un objet dictionary dans ta macro??)

Sub UserForm_Initialize()  
Dim liste  
With Sheets("Rép-Questions Comité")  
liste = Application.Transpose(.Range("C5:C" & .Range("C5000").End(xlUp).Row))  
TrieTableau liste, 0, UBound(liste)  

Me.choix.List = liste  
Me.choix.MultiSelect = fmMultiSelectMulti  

End Sub


et une méthode de tri rapide

Sub TrieTableau(T, Deb As Long, Fin As Long)  
    'auteur Thierry Pourtier (Ti) méthode de tri quicksort (Nb éléments>1000) _  
            décédé accidentellement (moto) le 13 novembre 2010; Adieu l'Ami.  
   Dim IndiceInf As Long, IndiceSup As Long  
   Dim Temp1, Pivot  
     
     IndiceInf = Deb  
     IndiceSup = Fin  
     Pivot = UCase(T((Deb + Fin) \ 2))  
     Do  
       While UCase(T(IndiceInf)) < Pivot  
         IndiceInf = IndiceInf + 1  
       Wend  
       While Pivot < UCase(T(IndiceSup))  
         IndiceSup = IndiceSup - 1  
       Wend  
       If IndiceInf <= IndiceSup Then  
         Temp1 = T(IndiceInf)  
         T(IndiceInf) = T(IndiceSup)  
         T(IndiceSup) = Temp1  
         IndiceInf = IndiceInf + 1  
         IndiceSup = IndiceSup - 1  
       End If  
     Loop Until IndiceInf > IndiceSup  
     If Deb < IndiceSup Then TrieTableau T, Deb, IndiceSup  
     If IndiceInf < Fin Then TrieTableau T, IndiceInf, Fin  
  End Sub


ajouté à 10:01 h
Si moins de 1000 éléments a trier

aulieu de  
trie tableau liste,0... 
écrire  
triabulle liste


Sub TriaBulle(T, Optional SensTri As Boolean = True) 
'auteur: Zon sur XLD 
    Dim Test As Boolean, I&, Temp 
     Do 
       Test = False 
       For I = LBound(T) To UBound(T) - 1 
         If (T(I) > T(I + 1) And SensTri) Or (T(I) < T(I + 1) And Not SensTri) Then 
           Temp = T(I) 
           T(I) = T(I + 1) 
           T(I + 1) = Temp 
           Test = True 
         End If 
       Next I 
     Loop Until Not Test 
  End Sub 

Michel
1
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
Modifié par gbinforme le 13/04/2011 à 00:05
bonjour

Une solution parmi d'autres qui trie ta liste et supprime les doubles :

Sub UserForm_Initialize()  
Dim mondico As New Collection, f As Worksheet, i As Integer, k As Integer  
Set f = Sheets("Rép-Questions Comité")  
On Error Resume Next  
mondico.Add ""  
For k = 5 To f.[C5000].End(xlUp).Row  
    i = 1  
    While i < mondico.Count And f.Cells(k, 3).Value > mondico.Item(i)  
        i = i + 1  
    Wend  
    mondico.Add f.Cells(k, 3).Value, f.Cells(k, 3).Value, i  
Next k  
mondico.Remove (mondico.Count)  
For k = 1 To mondico.Count  
    Me.choix.AddItem mondico.Item(k)  
Next k  
Me.choix.MultiSelect = fmMultiSelectMulti  

End Sub

Toujours zen
0