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
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
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