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
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
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 306
Modifié par michel_m le 13/04/2011 à 10:01
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??)
et une méthode de tri rapide
ajouté à 10:01 h
Si moins de 1000 éléments a trier
Michel
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
gbinforme
Messages postés
14946
Date d'inscription
lundi 18 octobre 2004
Statut
Contributeur
Dernière intervention
24 juin 2020
4 700
Modifié par gbinforme le 13/04/2011 à 00:05
Modifié par gbinforme le 13/04/2011 à 00:05
bonjour
Une solution parmi d'autres qui trie ta liste et supprime les doubles :
Toujours zen
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