Tri alphabétique dans une listbox ?

lebarbo

XLDnaute Occasionnel
Bonjour le forum, bonjour à tous,

Dans une feuille, je recense plusieurs nom qui ne sont pas trier par ordre alphabétique. Lorsque j'appelle un userform composé d'une listbox alimentée par ces noms, ceci sont rangés dans l'ordre chronologique. J'aimerai tout simplement, sans trier dans la feuille, mettre ces nom par ordre alphabétique dans la listbox.

J'alimente ma liste de la façon suivante :

ActiveWorkbook.Sheets("Feuil1").Names.Add Name:="Liste", RefersToR1C1:= _
"=Base!R2C3:R" & NoDerniereLigne & "C3"


For I = 1 To Sheets("Feuil1").Range("Liste").Count
ListBox1.AddItem Sheets("Feuil1").Range("Liste")(I)

Next

Merci d'avance
 

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Re : Tri alphabétique dans une listbox ?

Bonjour,

Code:
Private Sub UserForm_Initialize()
  Dim temp()
  temp = Range("liste")   ' liste tableau temp (1 To n,1 To 1) ou temp = Range([B2], [B2].End(xlDown)) 
  Call tri(temp, 1, UBound(temp, 1))
  Me.ListBox1.List = temp
End Sub

Sub tri(a(), gauc, droi)          ' Quick sort
 ref = a((gauc + droi) \ 2, 1)
 g = gauc: d = droi
 Do
     Do While a(g, 1) < ref: g = g + 1: Loop
     Do While ref < a(d, 1): d = d - 1: Loop
     If g <= d Then
       temp = a(g, 1): a(g, 1) = a(d, 1): a(d, 1) = temp
       g = g + 1: d = d - 1
     End If
 Loop While g <= d
 If g < droi Then Call tri(a, g, droi)
 If gauc < d Then Call tri(a, gauc, d)
End Sub

JB
Formation Excel VBA JB
 

lebarbo

XLDnaute Occasionnel
Re : Tri alphabétique dans une listbox ?

Bonjour,

Je viens d'essayer ton code et j'ai un bug sur :
temp = Range("liste") alors je l'ai remplacé par ce que tu disais à la suite :
temp = Range("C2:C" & NoDerniereLigne) là ça marché par contre j'ai un nouveau bug à suivre sur :
Do While ref < a(d, 1): d = d - 1: Loop
et je ne vois pas ce que sais.

Si tu as une idée ?

Merci
 

JPPei

XLDnaute Nouveau
Re : Tri alphabétique dans une listbox ?

Bonsoir,

Le petit bout de soft fourni en exemple pour trier une liste quelconque est brillant.
Je l'ai repris et adapté à une petite application. Merci.
Aurais-tu la même routine pour opérer un tri décroissant ?
Ce doit être assez facile de faire la transposée, mais il est tard et ça suppose de se creuser un peu les méninges.

JPP
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : Tri alphabétique dans une listbox ?

Bonsoir lebarbo, BOISGONTIER, PascalXLD, JPPei,
Bonsoir,Aurais-tu la même routine pour opérer un tri décroissant ?
On peut aussi renverser le tableau trié avant de remplir la liste ou renverser directement la liste après l'avoir remplie avec le tableau trié:
VB:
Private Sub UserForm_Initialize()
Dim temp()
  temp = Range([B2], [B2].End(xlDown))
  Call Tri(temp, 1, UBound(temp, 1))
  
' Choisir une des deux méthodes -
  
'  ' méthode 1 -> inversion de temp
'  RenverserTableau temp
'  Me.ListBox1.List = temp
  
'  '  ou méthode 2 -> inversion de la liste
'  Me.ListBox1.List = temp
'  RenverserListe Me.ListBox1

End Sub
avec
VB:
Sub RenverserListe(xListBox)
  Dim T(), J As Long, J1 As Long, J2 As Long, Jf As Long, K As Long, Aux
  T = xListBox.List
  J1 = LBound(T): J2 = UBound(T): Jf = Int((J2 - J1 + 1) / 2) - 1: K = LBound(T, 2)
  For J = 0 To Jf
    Aux = T(J2 - J, K): T(J2 - J, K) = T(J1 + J, K): T(J1 + J, K) = Aux
  Next J
  xListBox.List = T
End Sub

Sub RenverserTableau(T())
  Dim J As Long, J1 As Long, J2 As Long, Jf As Long, K As Long, Aux
  J1 = LBound(T): J2 = UBound(T): Jf = Int((J2 - J1 + 1) / 2) - 1: K = LBound(T, 2)
  For J = 0 To Jf
    Aux = T(J2 - J, K): T(J2 - J, K) = T(J1 + J, K): T(J1 + J, K) = Aux
  Next J
End Sub
 

Pièces jointes

  • F_liste_triee v2.xls
    54 KB · Affichages: 136
Dernière édition:

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Re : Tri alphabétique dans une listbox ?

Bonjour,

Code:
Sub Tri(a(), gauc, droi)          ' Quick sort décroissant
 ref = a((gauc + droi) \ 2, 1)
 g = gauc: d = droi
 Do
     Do While a(g, 1) > ref: g = g + 1: Loop
     Do While ref > a(d, 1): d = d - 1: Loop
     If g <= d Then
       temp = a(g, 1): a(g, 1) = a(d, 1): a(d, 1) = temp
       g = g + 1: d = d - 1
     End If
 Loop While g <= d
 If g < droi Then Call Tri(a, g, droi)
 If gauc < d Then Call Tri(a, gauc, d)
End Sub

Code:
Private Sub UserForm_Initialize()
  Set f = Sheets("BD")
  Dim temp()
  temp = f.Range("B2:B" & f.[B65000].End(xlUp).Row).Value
  Call Tri(temp, 1, UBound(temp, 1), 0)   ' 1:Croissant 0:décroissant
  Me.ListBox1.List = temp
End Sub

Sub Tri(a(), gauc, droi, ordre)        ' Quick sort  Ordre=1 Croissant/Ordre=0:décroissant
 ref = a((gauc + droi) \ 2, 1)
 g = gauc: d = droi
 Do
    If ordre = 1 Then
     Do While a(g, 1) < ref: g = g + 1: Loop
     Do While ref < a(d, 1): d = d - 1: Loop
    Else
     Do While a(g, 1) > ref: g = g + 1: Loop
     Do While ref > a(d, 1): d = d - 1: Loop
    End If
     If g <= d Then
       temp = a(g, 1): a(g, 1) = a(d, 1): a(d, 1) = temp
       g = g + 1: d = d - 1
     End If
 Loop While g <= d
 If g < droi Then Call Tri(a, g, droi, ordre)
 If gauc < d Then Call Tri(a, gauc, d, ordre)
End Sub


JB
 

Pièces jointes

  • F_liste_triee_Croissant_Decroissant.xls
    53 KB · Affichages: 184
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 229
Messages
2 086 426
Membres
103 206
dernier inscrit
diambote