Tri croissant ListBox
Résolu
sygmajf99
Messages postés
14
Date d'inscription
Statut
Membre
Dernière intervention
-
michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention -
michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention -
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 !!!
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 !!!
A voir également:
- Tri croissant ListBox
- Excel trier par ordre croissant chiffre - Guide
- Logiciel tri photo - Guide
- Vba trier colonne par ordre croissant - Forum VB / VBA
- Tri turf - Télécharger - Sport
- En cours de traitement sur le site de tri local ✓ - Forum Réseaux sociaux
2 réponses
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
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
