Trier un ListBox multicolonnes sans faire appel à un tableau

Bonjour à toutes et à tous,

je viens encore faire appel à vos lumières pour "Trier un ListBox multicolonnes sans faire appel à un tableau". Je m'explique :

J'ai une BASE qui contient des données apportées par plusieurs UserForm et qu'il ne faut en aucun cas modifier.

A l'aide d'un ComboBox, je sélectionne certaines données de la BASE que je stocke provisoirement sur la feuille RAPPORTS (vierge à l'initialisation) pour un premier tri et que j'affiche dans ListBox1.

Par double-click sur une ligne ListBox1, j'affiche les données correspondantes dans Listbox2 multi-colonnes.

Je voudrais pouvoir trier le ListBox2 en choisissant certaines colonnes et c'est là que je fais appel à votre expérience, toutes mes tentatives, malgré les recherches sur le Net s'étant soldées par un échec

- J'aurais aussi souhaité comprendre pourquoi le ListBox1 m'affiche deux fois la première ligne lorsque la valeur contient un chiffre (Suivi 1, Protocole 1, 1 Unité), mais pas lorsqu'il s'agit du Nom, ni du NumRef (5 chiffres), mais bien deux fois pour le Code (DDD)

- par ailleurs, il m'est impossible d'afficher les en-têtes dans le ListBox2

Je remercie par avance celle ou celui qui voudra bien prendre le temps de me répondre.

Bien cordialement

92tri-listbox.xlsm (106.58 Ko)

Bonjour,

Trier un ListBox multicolonnes sans faire appel à un tableau...

Je voudrais pouvoir trier le ListBox2 en choisissant certaines colonnes et c'est là que je fais appel à votre expérience, toutes mes tentatives, malgré les recherches sur le Net s'étant soldées par un échec

Utilises un tableau en mémoire afin de faire le tri avant de l'afficher :

Sub Tri(Tbl())

    Dim I As Long
    Dim J As Long
    Dim Temp1
    Dim Temp2
    Dim Temp3
    Dim Temp4
    Dim Temp5
    Dim Temp6
    Dim Temp7
    Dim Temp8
    Dim Temp9
    Dim Temp10

    For I = 1 To UBound(Tbl(), 2)

        For J = 1 To UBound(Tbl(), 2)

        'le tri est effectué sur la seconde colonne du tableau
        '< croissant, > décroissant
            If Tbl(2, I) < Tbl(2, J) Then

                Temp1 = Tbl(1, I)
                Temp2 = Tbl(2, I)
                Temp3 = Tbl(3, I)
                Temp4 = Tbl(4, I)
                Temp5 = Tbl(5, I)
                Temp6 = Tbl(6, I)
                Temp7 = Tbl(7, I)
                Temp8 = Tbl(8, I)
                Temp9 = Tbl(9, I)
                Temp10 = Tbl(10, I)

                Tbl(1, I) = Tbl(1, J)
                Tbl(2, I) = Tbl(2, J)
                Tbl(3, I) = Tbl(3, J)
                Tbl(4, I) = Tbl(4, J)
                Tbl(5, I) = Tbl(5, J)
                Tbl(6, I) = Tbl(6, J)
                Tbl(7, I) = Tbl(7, J)
                Tbl(8, I) = Tbl(8, J)
                Tbl(9, I) = Tbl(9, J)
                Tbl(10, I) = Tbl(10, J)

                Tbl(1, J) = Temp1
                Tbl(2, J) = Temp2
                Tbl(3, J) = Temp3
                Tbl(4, J) = Temp4
                Tbl(5, J) = Temp5
                Tbl(6, J) = Temp6
                Tbl(7, J) = Temp7
                Tbl(8, J) = Temp8
                Tbl(9, J) = Temp9
                Tbl(10, J) = Temp10

            End If

    Next J, I

End Sub
Dim Tbl()
Dim I As Long

With Worksheets("BASE").UsedRange

    'Recherche dans la colonne B (2) la valeur de la cellule modifiée (D3)
    Set c = .Find(ListBox1.List(ListBox1.ListIndex), LookIn:=xlValues, lookat:=xlWhole)

    If Not c Is Nothing Then
        Prem = c.Address
        Do
            With Me.ListBox2

                Tbl(1, I) = c.Row
                Tbl(2, I) = c.Offset(, 1 - c.Column)  'recherche le Nom Col 1
                Tbl(3, I) = c.Offset(, 5 - c.Column)  'recherche le Suivi col 4
                Tbl(4, I) = c.Offset(, 11 - c.Column)  'affiche NumRef col 2
                Tbl(5, I) = c.Offset(, 6 - c.Column)  'affiche Code col 3
                Tbl(6, I) = c.Offset(, 7 - c.Column) 'affiche date 1
                Tbl(7, I) = c.Offset(, 8 - c.Column)  'affiche date 2
                Tbl(8, I) = c.Offset(, 9 - c.Column)  'affiche date 3
                Tbl(9, I) = c.Offset(, 10 - c.Column)  'affiche date 4
                Tbl(10, I) = c.Offset(, 3 - c.Column)  'affiche date 5

            End With

            Set c = .FindNext(c)

        Loop While Not c Is Nothing And c.Address <> Prem

    End If

End With

Tri Tbl()

With Me.ListBox2

    .Clear
    .ColumnCount = 12
    .BoundColumn = 1
    .ColumnHeads = True
    .ColumnWidths = "20; 60; 60; 65; 65; 65; 65; 65; 65; 30"
    .List = Application.Transpose(Tbl()) '<--- chargement du tableau dans la ListBox

End With

- par ailleurs, il m'est impossible d'afficher les en-têtes dans le ListBox2

Tout simplement parce que seule la propriété "RowSource" permet d'avoir des entêtes de colonne

Bonjour Theze

Merci pour cette réponse (toujours aussi rapide !).

J'ai mis le code en application dans mon projet et ça fonctionne

Si j'ai bien compris, il faut créer un module différent selon la colonne que que l'on veut trier.

J'avais oublié la nécessité de RowSource pour afficher les en-têtes de colonne.

Y a t-il une explication pourquoi le ListBox1 m'affiche deux fois la première ligne lorsque la valeur contient un chiffre (Suivi 1, Protocole 1, 1 Unité), mais pas lorsqu'il s'agit du Nom, ni du NumRef (5 chiffres), mais bien deux fois pour le Code (DDD) ?

Merci encore.

Le problème est résolu (j'ai coché la case).

Bonjour,

Le problème est résolu mais comme tu demandes :

Si j'ai bien compris, il faut créer un module différent selon la colonne que que l'on veut trier.

Non, il suffit de passer en argument le numéro de colonne voulu :

Sub Tri(Tbl(), NumCol As Integer)

    Dim I As Long
    Dim J As Long
    Dim Temp1
    Dim Temp2
    Dim Temp3
    Dim Temp4
    Dim Temp5
    Dim Temp6
    Dim Temp7
    Dim Temp8
    Dim Temp9
    Dim Temp10

    For I = 1 To UBound(Tbl(), 2)

        For J = 1 To UBound(Tbl(), 2)

        'le tri est effectué sur la seconde colonne du tableau
        '< croissant, > décroissant
            If Tbl(NumCol, I) < Tbl(NumCol, J) Then

                Temp1 = Tbl(1, I)
                Temp2 = Tbl(2, I)
                Temp3 = Tbl(3, I)
                Temp4 = Tbl(4, I)
                Temp5 = Tbl(5, I)
                Temp6 = Tbl(6, I)
                Temp7 = Tbl(7, I)
                Temp8 = Tbl(8, I)
                Temp9 = Tbl(9, I)
                Temp10 = Tbl(10, I)

                Tbl(1, I) = Tbl(1, J)
                Tbl(2, I) = Tbl(2, J)
                Tbl(3, I) = Tbl(3, J)
                Tbl(4, I) = Tbl(4, J)
                Tbl(5, I) = Tbl(5, J)
                Tbl(6, I) = Tbl(6, J)
                Tbl(7, I) = Tbl(7, J)
                Tbl(8, I) = Tbl(8, J)
                Tbl(9, I) = Tbl(9, J)
                Tbl(10, I) = Tbl(10, J)

                Tbl(1, J) = Temp1
                Tbl(2, J) = Temp2
                Tbl(3, J) = Temp3
                Tbl(4, J) = Temp4
                Tbl(5, J) = Temp5
                Tbl(6, J) = Temp6
                Tbl(7, J) = Temp7
                Tbl(8, J) = Temp8
                Tbl(9, J) = Temp9
                Tbl(10, J) = Temp10

            End If

    Next J, I

End Sub

que tu appelles :

Tri Tbl(), 2

Bonjour,

Exemples de tri rapide de ListBox multi-colonnes

Private Sub UserForm_Initialize()
  Set f = Sheets("BD")
  a = f.Range("A2:C" & f.[A65000].End(xlUp).Row)
  Tri a, 1, LBound(a), UBound(a)
  Me.ListBox1.list = a
End Sub

Private Sub CommandTriNom_Click()
  Dim a()
  a = Me.ListBox1.list
  Tri a(), 1, LBound(a, 1), UBound(a, 1)
  Me.ListBox1.list = a
End Sub

Private Sub CommandTriCompte_Click()
  Dim a()
  a = Me.ListBox1.list
  Tri a(), 0, LBound(a, 1), UBound(a, 1)
  Me.ListBox1.list = a
End Sub

Sub Tri(a, ColTri, gauc, droi) ' Quick sort
  ref = a((gauc + droi) \ 2, ColTri)
  g = gauc: d = droi
  Do
    Do While a(g, ColTri) < ref: g = g + 1: Loop
    Do While ref < a(d, ColTri): d = d - 1: Loop
    If g <= d Then
       For k = LBound(a, 2) To UBound(a, 2)
         temp = a(g, k): a(g, k) = a(d, k): a(d, k) = temp
       Next k
       g = g + 1: d = d - 1
    End If
  Loop While g <= d
  If g < droi Then Call Tri(a, ColTri, g, droi)
  If gauc < d Then Call Tri(a, ColTri, gauc, d)
End Sub

Ceuzin

Merci Theze,

J'ai compris le principe.

Bonjour et merci ceuzin. Je connais le site de Boisgontierjacques qui est une mine d'informations, mais souvent pas assez détaillées pour la mise en oeuvre par un débutant comme moi , aussi n'y avais-je pas fait appel. Mais les deux premiers exemples me semblent vraiment intéressants (le 3ème présente une erreur au lancement).

Merci à tous les deux.

Bonne journée

Bonjour à tous,

Malheureusement les exemples de M Boisgntierjacques, font tous appel à un tableau "ListBox1 = .Range("A:F" &... " alors que mon problème est de trier un ListBox2 alimenté par un ListBox1. A moins de créer un tableau sur la feuille RAPPORTS à partir du ListBox1, puis d'alimenter le ListBox2 à partir du tableau, mais je ne vois pas comment alimenter ce tableau intermédiaire, mes différentes tentatives s'étant soldées par des échecs

Cordialement

Cf exemple

Option Compare Text
Dim f, RngTitre
Private Sub UserForm_Initialize()
   Set f = Sheets("bd")
   Me.ListBox1.List = f.Range("A2:E" & f.[A65000].End(xlUp).Row).Value
   Set RngTitre = f.Range("A1:E1")
   Me.ComboBox1.List = Application.Transpose(RngTitre.Value)
   Me.ComboBox1.ListIndex = -1
End Sub

Private Sub ComboBox1_click()
   Dim Tbl()
   Tbl = Me.ListBox1.List
   colTri = Application.Match(Me.ComboBox1, RngTitre, 0) - 1
   Tri Tbl(), LBound(Tbl), UBound(Tbl), colTri
   Me.ListBox1.List = Tbl
End Sub

Private Sub B_recup_Click()
  Dim Tbl()
  Me.ListBox2.List = Me.ListBox1.List
  Tbl = Me.ListBox2.List
  colTri = 0   ' tri par nom
  Tri Tbl(), LBound(Tbl), UBound(Tbl), colTri
  Me.ListBox2.List = Tbl
End Sub

Sub Tri(a(), gauc, droi, colTri)        ' Quick sort
 colD = LBound(a, 2): colF = UBound(a, 2)
 ref = a((gauc + droi) \ 2, colTri)
 g = gauc: d = droi
 Do
     Do While a(g, colTri) < ref: g = g + 1: Loop
     Do While ref < a(d, colTri): d = d - 1: Loop
     If g <= d Then
       For c = colD To colF
         temp = a(g, c): a(g, c) = a(d, c): a(d, c) = temp
       Next
       g = g + 1: d = d - 1
     End If
 Loop While g <= d
 If g < droi Then Tri a, g, droi, colTri
 If gauc < d Then Tri a, gauc, d, colTri
End Sub

Ceuzin

Merci ceuzin pour ce nouvel envoi,

mais il y a un premier tri sur la BASE qui sélectionne certains critères qui s'affichent dans le ListBox1.

Puis en sélectionnant une ligne dans ListBox1 on affiche dans le ListBox2 des valeurs d'une autre feuille qui n'ont rien à voir avec le premier tri et sur lesquelles devrait se faire un nouveau tri. (le nombre de colonnes dans un ListBox étant limité à 10, il est impossible de faire le tri dès le ListBox1 en y mettant toutes les données).

Ces tris ne doivent pas modifier la base. L'affichage et le tri dans ListBox2 servent à l'observation et l'analyse des données afin de modifier les stratégies.

C'est pourquoi j'avais pensé à utiliser la feuille RAPPORTS comme tableau intermédiaire, puis le visualiser dans le ListBox2, ce qui permet de le trier grâce au .Range... mais je me mélange les pinceaux et j'avais pondu ça :

Dim cell As Range

With Worksheets("BASE").UsedRange

Set Ws = Worksheets("BASE")

Set c = .Find(ListBox1.List(ListBox1.ListIndex), LookIn:=xlValues, lookat:=xlWhole)

'With Sheets("RAPPORTS")

For Each cell In Sheets("BASE").Range("A2:L" & Ws.[A65000].End(xlUp).Row).Value

If cell.Value = c Then

.Range("A1:A1000").Value = Ws.Range("A2:A" & Ws.[A65000].End(xlUp).Row).Value

.Range("B1:B1000").Value = Ws.Range("B2:B" & Ws.[C65000].End(xlUp).Row).Value

.Range("C1:C1000").Value = Ws.Range("C2:C" & Ws.[P65000].End(xlUp).Row).Value

etc.

End If

Next cell

End With

Qui ne fonctionne pas...

>le nombre de colonnes dans un ListBox étant limité à 10, il est impossible de faire le tri dès le ListBox1 en y mettant toutes les données).

Faux

Additem n'accepte pas plus de 10 colonnes. Il faut alimenter la ListBox par un tableau 2D.

http://boisgontierjacques.free.fr/pages_site/formulaireListes2colonnes.htm#12col

Ceuzin

Merci Ceuzin,

je vais voir si c'est possible, parce que entre ListBox1 et ListBox2, on n'attaque plus les mêmes feuilles (c'est un gros projet avec des dizaines de colonnes, l'échantillon envoyé ne reflète pas du tout la réalité, mais le principe de fonctionnement est strictement le même).

J'aimerais aussi essayer le tableau provisoire sur la feuille RAPPORTS.

Bonne soirée

Bonsoir,

je viens comme un cheveux sur la soupe...

Le bouton "init" fait disparaître et apparaître le USF... Perso je n'aime pas...

Ci-joint une modification :

C'est juste comme ça...

Pour le reste bravo à Theze et ceuzin (qui doit avoir un abonnement sur BJ.FREE.FR )

@ bientôt

LouReeD

Bonsoir LouReeD et merci,

c'est beaucoup plus esthétique comme ça. Je vais l'utiliser pour les autres init aussi (je connaissait pas).

Un coup de main pour le tableau provisoire sur la feuille RAPPORTS ?

Dim cell As Range

With Worksheets("BASE").UsedRange

Set Ws = Worksheets("BASE")

Set c = .Find(ListBox1.List(ListBox1.ListIndex), LookIn:=xlValues, lookat:=xlWhole)

'With Sheets("RAPPORTS")

For Each cell In Sheets("BASE").Range("A2:L" & Ws.[A65000].End(xlUp).Row).Value

If cell.Value = c Then

.Range("A1:A1000").Value = Ws.Range("A2:A" & Ws.[A65000].End(xlUp).Row).Value

.Range("B1:B1000").Value = Ws.Range("B2:B" & Ws.[C65000].End(xlUp).Row).Value

.Range("C1:C1000").Value = Ws.Range("C2:C" & Ws.[P65000].End(xlUp).Row).Value

etc.

End If

Next cell

End With

Rechercher des sujets similaires à "trier listbox multicolonnes appel tableau"