trier ordre croissant ou décroissant une listbox par une colonne X

patricktoulon · 15 Juin 2020

bonjour a tous
je me suis fait une petite sub de tri par colonne (croissant ou décroissant) pour une listbox
en l’état elle fonctionne
mais il y a un truc qui me taraude et me fait des nœuds dans les cheveux
je suis obligé de faire un récursif du code (tri décroissant puis croissant) pour la trier en ordre croissant
sinon j'ai toujours l'index 0 qui reste en top
c'est un truc que je pige pas
le principe est simple c'est une double boucle imbriquée et elle démarre toute les deux a zéro
en commentaire vous verrez les anciennes lignes qui servaient a trier la listbox à 1 colonne et qui n'avait pas besoins de ce looping affreux
j'ai juste utilisé index pour mémoriser les lignes (I et A)entières au lieu de l'item(A,0)
que je replace dans une 3 eme boucle sur le nombre de colonne

bref le principe est on ne peut plus simple

le code

débloquez les lignes qui ont"*****" en commentaire pour que le tri croissant fonctionne

VB:

'**********************************************************************************
'débloquez les lignes qui ont "*****" pour corriger l'erreur de l'item(0,colonne )!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'**********************************************************************************
Sub SortOrder(LtBx, Optional sens As Long = 1, Optional col As Long = 1)    'sens=1 ordre croissant sens=0 ordre decroissant
    Dim temp$, TbLA, TbLI, D&, A&, I&, Rev
    col = col - 1
    'If sens = 1 Then sens = 0: Rev = True    '*****
're:        '******
    With LtBx
        For I = 0 To .ListCount - 1
            For A = 0 To .ListCount - 1
                TbLA = Application.Index(.List(), A + 1, 0)
                TbLI = Application.Index(.List(), I + 1, 0)
                If sens = 1 Then
                    If .List(I, col) < .List(A, col) Then
                        'temp = .List(a, col): .List(a, col) = .List(i, col): .List(i, col) = temp'ancien tri sur colonne 0
                        For c = LBound(TbLA) To UBound(TbLA)
                            .List(I, c - 1) = TbLA(c): .List(A, c - 1) = TbLI(c)
                        Next
                    End If
                Else
                    If .List(I, col) > .List(A, col) Then
                        'temp = .List(a, col): .List(a, col) = .List(i, col): .List(i, col) = temp'ancien tri sur colonne 0
                        For c = LBound(TbLA) To UBound(TbLA)
                            .List(I, c - 1) = TbLA(c): .List(A, c - 1) = TbLI(c)
                        Next
                    End If
                End If
            Next A
        Next I
    End With
    'If Rev = True Then sens = 1: Rev = False: GoTo re    '*****
End Sub

l'appel de la sub de tri
SortOrder ListBox1 , sens(1 ou 0) , colonne en base 1!!!!(1= colonne 0 de la listbox)

si quelqu'un peut m'expliquer pourquoi je suis obligé de faire cela, ça m’intéresse
je joins un petit fichier exemple

_Thierry · 15 Juin 2020

Bonjour Patrick

Avec le code en l'état quand on ouvre ton fichier exemple, si je prends "Toto" il me semble qu'il y a une abérration non ?

Donc déjà ca me semble bizare ou je n'ai pas compris ce que tu cherches à faire...

Ensuite j'ai essayé "l'ancien tri" si je ne me suis pas planté :

VB:

Sub SortOrder(LtBx, Optional sens As Long = 1, Optional col As Long = 1)    'sens=1 ordre croissant sens=0 ordre decroissant
    Dim temp$, TbLA, TbLI, D&, A&, I&, Rev
    col = col - 1
    If sens = 1 Then sens = 0: Rev = True    '*****
re:        '******
    With LtBx
        For I = 0 To .ListCount - 1
            For A = 0 To .ListCount - 1
                TbLA = Application.Index(.List(), A + 1, 0)
                TbLI = Application.Index(.List(), I + 1, 0)
                If sens = 1 Then
                    If .List(I, col) < .List(A, col) Then
                        temp = .List(A, col): .List(A, col) = .List(I, col): .List(I, col) = temp 'ancien tri sur colonne 0
''                        For c = LBound(TbLA) To UBound(TbLA)
''                            .List(I, c - 1) = TbLA(c): .List(A, c - 1) = TbLI(c)
''                        Next
                    End If
                Else
                    If .List(I, col) > .List(A, col) Then
                        temp = .List(A, col): .List(A, col) = .List(I, col): .List(I, col) = temp 'ancien tri sur colonne 0
''                        For c = LBound(TbLA) To UBound(TbLA)
''                            .List(I, c - 1) = TbLA(c): .List(A, c - 1) = TbLI(c)
''                        Next
                    End If
                End If
            Next A
        Next I
    End With
    If Rev = True Then sens = 1: Rev = False: GoTo re    '*****
End Sub

Mais le tri me semble aussi assez farfelu :

Je ne sais plus trop ce que tu cherches en fait ?
Un mélangeur aléatoire style "téquila boumboum"

Bon courage
@+Thierry

patricktoulon · 15 Juin 2020

Bonjour Thierry
ben alors on a des soucis pour lire ce matin ?
je tri la listbox par la colonne 2 tout simplement

et a la vue de ta capture elle fait le job
quelque chose me dis que la tequila tu connais

_Thierry · 15 Juin 2020

Arf !
Oui pourtant j'ai lu deux fois, mais c'est pas vraiment catholique ça LoL !
C'est franchement la première fois que je vois une désynchronisation volontaire dans une ListBox Multi-Colonnes...
Euh ca sert à quoi ?
Pour faire plus de bulles dans la téquila ?
@+Thierry

_Thierry · 15 Juin 2020

Re Arf
Ce dont je n'avais pas fait attention non plus c'est que tu as trois Toto dans la Base initiale LoL !!!
@+Thierry

patricktoulon · 15 Juin 2020

oulah thierry ben toi tu en tiens une bonne alors

elle n'est pas désynchronisé regarde bien
ton exemple toto 36 c'est juste il y en a bien 2

patricktoulon · 15 Juin 2020

le problème est juste la ligne 0 qui n'est pas a la bonne place si je fait pas le looping avec les deux sens tris

mais je crois avoir compris il faut que je fasse autrement

_Thierry · 15 Juin 2020

Oui je ne suis pas au top forme en ce moment.
Il y a un bail en 2005, j'avais fait cette démo au cas où pour les SortS de ListBox, je ne sais pas si ça peut te donner une idée...

Bien à toi
@+Thierry

patricktoulon · 15 Juin 2020

Merci Thierry je vais regarder

patricktoulon · 15 Juin 2020

@thierry
purrée costaud ton truc
lourd aussi
en ce qui concerne ma méthode je n'ai pas trouvé mieux que ce looping affreux

patricktoulon · 15 Juin 2020

bon finalement j'ai trouvé tout seul
suis je bete !!!?
a reculons ça fonctionne mieux

VB:

Option Explicit
Private Sub UserForm_Activate()
    remplissage
End Sub
Sub remplissage()
    With ListBox1: .List = Range("A1:B22").Value: .ColumnCount = 2: End With
End Sub
Private Sub CommandButton4_Click()
    remplissage
End Sub

Private Sub CommandButton3_Click()
    SortOrder ListBox1, 1, 2
End Sub

Private Sub CommandButton2_Click()
    SortOrder ListBox1, 0, 2    ' croissant
End Sub


Sub SortOrder(LtBx, Optional sens As Long = 1, Optional col As Long = 1)    'sens=1 ordre croissant sens=0 ordre decroissant
    Dim temp$, TbLA, TbLI, A&, I&, C&
    col = col - 1
    With LtBx
        For I = .ListCount - 1 To 0 Step -1
            For A = .ListCount - 1 To 0 Step -1
                TbLA = Application.Index(.List(), A + 1, 0)
                TbLI = Application.Index(.List(), I + 1, 0)
                If sens = 1 Then
                    If .List(I, col) < .List(A, col) Then
                        For C = LBound(TbLA) To UBound(TbLA): .List(I, C - 1) = TbLA(C): .List(A, C - 1) = TbLI(C): Next
                    End If
                Else
                    If .List(I, col) > .List(A, col) Then
                        For C = LBound(TbLA) To UBound(TbLA): .List(I, C - 1) = TbLA(C): .List(A, C - 1) = TbLI(C): Next
                    End If
                End If
            Next A
        Next I
    End With
End Sub

et je suis quasiment sur que je peux diminuer encore le code au niveau des boucles C

pierrejean · 15 Juin 2020

Bonjour a tous
J'ai regardé et voici ce que j'obtiens
(un peu bourrin je vous l'accorde)

trier ordre croissant ou décroissant une listbox par une colonne X

patricktoulon

XLDnaute Barbatruc

Pièces jointes

_Thierry

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

_Thierry

XLDnaute Barbatruc

_Thierry

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

_Thierry

XLDnaute Barbatruc

Pièces jointes

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

pierrejean

XLDnaute Barbatruc

Pièces jointes

Discussions similaires