Tri alphabétique d'une listBox - données en ligne sur excel

cafiniou13

XLDnaute Nouveau
Bonjour à tous,

Je sais d'avance que certains diront que ma question est un cas d'école, et qu'il y a des réponses dans la FAQ du site ou sur google, mais j'avoue qu'après pas mal de recherches, je n'arrive pas à m'en sortir.
Please, lisez au moins mon cas avant de m'envoyer bouler.

J'ai un UserForm avec une listBox, que j'alimente avec la solution AddItem.
Les données, issues de la feuille de calcul "BD form", sont en fait mes titres de colonnes (soit la zone de B1 à Z1).
J'ai réussi à alimenter ma listebox, mais les données ne sont pas classées par ordre alphabétique.

Voici mon code :
Code:
Private Sub UserForm_Initialize()
        Dim BDF As Worksheet
        Dim l As Range
        Dim t_prem As Range, t_dern As Range
                
    Set BDF = Worksheets("BD form")
    Set t_prem = BDF.Range("B1")
    Set t_dern = BDF.Range("IV1").End(xlToLeft)

' Récupère les formations pour la liste multichoix
    ListBox1.ColumnCount = 2
    ListBox1.Clear
    For Each l In BDF.Range(t_prem, t_dern)
        If l.Value <> "" Then
            ListBox1.AddItem l.Column
            ListBox1.List(ListBox1.ListCount - 1, 1) = l.Value
        End If
    Next
    
End Sub

Pourriez vous me donner un coup de main. Tous les exemples que j'ai vu sont basé sur des listes qui sont sur une même colonne.
Au fait, dois-je préciser que je débute ?
Merci d'avance à ceux qui se pencheront sur le sujet.
A+ (enfin j'espère)
 
Dernière édition:

pierrejean

XLDnaute Barbatruc
Re : Tri alphabétique d'une listBox - données en ligne sur excel

bonjour cafiniou

Teste ceci

Code:
Private Sub UserForm_Initialize()
        Dim BDF As Worksheet
        Dim l As Range
        Dim t_prem As Range, t_dern As Range
        
                
    Set BDF = Worksheets("BD form")
    Set t_prem = BDF.Range("B1")
    Set t_dern = BDF.Range("IV1").End(xlToLeft)
    Dim tablo()
    ReDim tablo(2, 0)
' Récupère les formations pour la liste multichoix
    ListBox1.ColumnCount = 2
    ListBox1.Clear
    'mise en tableau des infos
    For Each l In BDF.Range(t_prem, t_dern)
        If l.Value <> "" Then
           tablo(1, UBound(tablo, 2)) = l.Column
           tablo(2, UBound(tablo, 2)) = l.Value
           ReDim Preserve tablo(2, UBound(tablo, 2) + 1)
        End If
    Next
    'Tri du tableau
    For n = LBound(tablo, 2) To UBound(tablo, 2) - 1
      For m = LBound(tablo, 2) To UBound(tablo, 2) - 1
         If tablo(2, m) > tablo(2, n) Then
           temp1 = tablo(1, n)
           temp2 = tablo(2, n)
           tablo(1, n) = tablo(1, m)
           tablo(2, n) = tablo(2, m)
           tablo(1, m) = temp1
           tablo(2, m) = temp2
         End If
      Next m
    Next n
    'transfert du tableau a la listbox
    For n = LBound(tablo, 2) To UBound(tablo, 2) - 1
      ListBox1.AddItem tablo(1, n)
      ListBox1.List(ListBox1.ListCount - 1, 1) = tablo(2, n)
    Next n
End Sub
 

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Re : Tri alphabétique d'une listBox - données en ligne sur excel

Bonjour,


Code:
Private Sub UserForm_Initialize()
  Dim temp()
  temp = Range("liste3")   ' 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 rapide
 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
 

cafiniou13

XLDnaute Nouveau
Re : Tri alphabétique d'une listBox - données en ligne sur excel

Merci à PierreJean et Boisgontier pour votre travail.
J'ai finalement pris la solution de PierreJean qui marche à merveille ;)
La solution de Boigontier m'affiche un bug avant l'ouverture de l'Userform.

D'habitude je cherche à comprendre, mais j'ai tellement passer de temps dessus avant de faire ma demande sur ce site que là je suis tellement contente d'avoir une solution qui fonctionne que je vais pas vous prendre la tête pour déboguer la deuxième.

ENCORE MERCI, MERCI, MERCI !!!!!!!!!!:rolleyes:
 

Discussions similaires

Statistiques des forums

Discussions
311 740
Messages
2 082 047
Membres
101 880
dernier inscrit
Anton_2024