XL 2019 Tri automatique d'une listbox après filtrage dans une combobox

DELHOMME · 26 Février 2020

Bonjour,

Dans un userform, et à partir d'un filtrage que je fais à travers une combobox, je récupère les données filtrées automatiquement dans une listbox (5 colonnes : date / Intervenant / Code d'intervention / Eléments d'intervention / Commentaire). Tout ceci marche.
Je souhaite maintenant trouver un code permettant que ces données soient automatiquement triées en fonction des dates par ordre décroissant.
Je ne souhaite pas réaliser ce tri, en amont, directement sur ma source de données.
Comment puis-je procéder ?
Merci pour vos retours.
Titoo

Ci-dessous mon code alimentant ma listbox :

'Procédure de recherche (historique) de l'ensemble des interventions
'contenues dans la SourceIntervention sur la vanne sélectionnée

Feuil4.Activate

Me.ListBox1.ColumnHeads = False
Me.ListBox1.ColumnCount = 16
Me.ListBox1.ColumnWidths = "55;80;0;50;260;200;0;0;0;0;0;0;0;0;0;0"

'Déclaration des variables
Dim Critere
Dim DerniereLigne As Integer, x As Integer

'Affectation des variables
Critere = cboVannemasquée.Value

'On récupère la dernière ligne de la source de données
If Cells(Rows.Count, 1).End(xlUp).Row = 1 Then
DerniereLigne = 2
Else
DerniereLigne = Cells(Rows.Count, 1).End(xlUp).Row
End If

'On efface le contenu de la liste à chaque recherche.
ListBox1.Clear
ListBox1.BackColor = RGB(200, 250, 255)

'On parcours la source de données de la ligne à la dernière ligne
For x = 1 To DerniereLigne

'On teste le critère, ici la valeur du cboVannemasquée avec la source de données
If Cells(x, 3) = Critere Then

'On écrit dans la listBox
Me.ListBox1.AddItem Cells(x, 1)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Cells(x, 2)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = Cells(x, 3)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = Cells(x, 4)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = Cells(x, 5)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = Cells(x, 6)

End If
Next x
End Sub

Dranreb · 26 Février 2020

Bonsoir.
C'est marrant, j'évolue tout doucement depuis des mois sur un projet basé sur votre fichier.
Qui sait, peut être que ça peut vous intéresser …

Édition: Attention, la plupart de vos dates n'en sont pas, ce sont des textes.

BOISGONTIER · 26 Février 2020

Bonjour,

Exemple de tri d'une ListBox

Boisgontier

DELHOMME · 26 Février 2020

Bonjour,

Dranreb : Ah oui, c'est marrant et je suis très content qu'il puisse vous servir de base de données. Merci pour votre retour concernant le format de mes dates - je vais vérifier mais le fichier a évolué et j'ai établi un code permettant d'imposer un format de date :
Private Sub txtDate_afterupdate()
txtDate.Value = Format(txtDate.Value, "DD / MM / YYYY")
End Sub

Boisgontier : Merci Jacques. Avant de poster cette discussion, j'avais déjà fait un tour sur votre site - c'est une mine d'or et un passage obligé pour chaque questionnement concernant VBA. J'avais même téléchargé le fichier que vous m'avez conseillé. Je débute en VBA et j'avoue que chaque avancée dans mon projet est une véritable recherche pédagogique. J'apprends en faisant...
Si vous me renvoyez ce fichier, c'est que je suis sur la bonne piste... J'avais vu que la plage concernée était l'ensemble de la base de donnée. Dans mon cas, j'effectue d'abord un filtrage de ma base de données à travers une combobox (un filtre conditionné) et par conséquent les données à trier dans la listbox ne sont plus celles de ma base de données initiales...
Je vais donc à nouveau essayer de comprendre votre code et voir si celui-ci peut être adapté en fonction de ce filtre.

Bien à vous deux,
Titoo

BOISGONTIER · 26 Février 2020

Voici un exemple avec un ComboBox et une ListBox

http://boisgontierjacques.free.fr/fichiers/Formulaire/FormTriComboBoxListBoxMultiCol.xlsm

VB:

Option Compare Text
Dim Tbl()
Private Sub UserForm_Initialize()
Set f = Sheets("BD")
Tbl = f.Range("A2:C" & f.[A65000].End(xlUp).Row).Value
Set d = CreateObject("scripting.dictionary")
d("*") = ""
For i = 1 To UBound(Tbl)
   d(Tbl(i, 2)) = ""
Next i
Me.ComboBox1.List = d.keys
Tri Tbl, LBound(Tbl), UBound(Tbl), 1
Me.ListBox1.List = Tbl
End Sub

Private Sub ComboBox1_Click()
   Dim Tbl2()
   n = 0
   For i = 1 To UBound(Tbl)
     If Tbl(i, 2) Like Me.ComboBox1 Then
       n = n + 1: ReDim Preserve Tbl2(1 To 3, 1 To n)
       For k = 1 To 3: Tbl2(k, n) = Tbl(i, k): Next k
     End If
   Next i
   Me.ListBox1.Column = Tbl2
   temp = Me.ListBox1.List
   Tri temp, 1, UBound(temp), 0
   Me.ListBox1.List = temp
End Sub

Sub Tri(a, gauc, droi, colTri)             ' 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 c = LBound(a, 2) To UBound(a, 2)
         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 Call Tri(a, g, droi, colTri)
If gauc < d Then Call Tri(a, gauc, d, colTri)
End Sub

Boisgontier

Dranreb · 26 Février 2020

DELHOMME à dit:
j'ai établi un code permettant d'imposer un format de date :

Ca ne sert à rien. La TextBox contient toujours un texte. C'est à son écriture dans une cellule qu'il doit avoir fait l'objet d'une conversion en date par la fonction CDate pour que ce ne soit pas un texte.

DELHOMME · 26 Février 2020

Dranreb : Oui merci pour cette correction. J'avais bien résolu cette conversion aussi - cf : mon code d'écriture ci-dessous.

Private Sub btnAjout_Click()

Sheets("SourceSignalement").Activate 'on va sur la feuille "SourceSignalement"
Range("A1").Select 'on se positionne sur la cellule A1
Selection.End(xlDown).Select 'on se positionne sur la dernière ligne non vide de la colonne A
Selection.Offset(1, 0).Select 'on se décale d'une ligne vers le bas
ActiveCell = CDate(txtDate) 'inscrit la date dans la cellule
ActiveCell.Offset(0, 1).Value = cboPilote 'se décalle d'une colonne à partir de la colonne A et inscrit le nom du pilote dans la cellule de la colonne B
ActiveCell.Offset(0, 2).Value = txtVanne 'se décalle de 2 colonnes à partir de la colonne A et inscrit le n° de vanne dans la cellule de la colonne C
ActiveCell.Offset(0, 4).Value = cboDrive 'se décalle de 4 colonnes à partir de la colonne A et inscrit l'état de la Drive dans la cellule de la colonne E
ActiveCell.Offset(0, 5).Value = cboFuite 'se décalle de 5 colonnes à partir de la colonne A et inscrit le choix oui/non dans la cellule de la colonne F
ActiveCell.Offset(0, 6).Value = cboRétroON 'se décalle de 6 colonnes à partir de la colonne A et inscrit l'état de la rétro ON dans la cellule de la colonne G
ActiveCell.Offset(0, 7).Value = cboRétroOFF 'se décalle de 7 colonnes à partir de la colonne A et inscrit l'état de la rétro OFF dans la cellule de la colonne H
ActiveCell.Offset(0, 8).Value = txtCommentaire 'se décalle de 8 colonnes à partir de la colonne A et inscrit le commentaire dans la cellule de la colonne I
Selection.Offset(0, 3).Select 'se decalle de 3 colonnes à partir de la colonne A et
Selection.Value = "M" 'inscrit "M" (Masquage) dans la cellule de la colonne D

Boisgontier : Merci Jacques, j'avais aussi téléchargé ce fichier au cours de ma recherche.

J'ai oublié de préciser que les données présentes dans ma combobox étaient elles-mêmes :

1) conditionnées dès l'ouverture de ce formulaire :

'***********************************************************************************
'Procédure permettant d'alimenter la liste déroulante "cbovannemasquée"
'à partir d'un tri de "SourceSignalement" des colonne C (N°vanne masquée)
'et colonne D (Etat vanne) = "M" (indication masquage)
'***********************************************************************************
Private Sub UserForm_Initialize() 'à l'ouverture du formulaire

Me.cboVannemasquée.SetFocus 'le curseur se position en priorité sur la liste déroulante vanne masquée

Dim J As Long 'on déclare une variable J de type entier long (Nombre entier compris entre - 2 147 483 648 et 2 147 483 647)
With Sheets("SourceSignalement") 'Dans la feuille "SourceSignalement"
For J = 2 To .Range("C" & Rows.Count).End(xlUp).Row 'la variable J est = la récupération de toutes les données de la colonne C (N°Vanne) de ligne 2 à la dernière ligne non vide
If .Range("D" & J) = "M" Then 'avec la condition que seules soient récupérées les données de la colonne C ayant comme élément indiqué "M" dans la colonne D (Etat Vanne), alors
Me.cboVannemasquée.AddItem .Range("C" & J) 'on récupère et on dispose dans la liste déroulante "cbovannemasquée" toutes ces données triées
End If
Next J
End With
End Sub

2) Puis le rapatriement des données dans différentes textbox du formulaire en fonction du choix dans cette combobox,

'***********************************************************************************
'Procédure permettant la rapatriement des données de la vanne masquée sélectionnée
'***********************************************************************************

Private Sub cboVannemasquée_Change()

Feuil1.Activate 'on se dirige vers la feuille "SourceSignalement"
Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Select 'on se positionne sur la dernière ligne vide de la colonne C (N° Vanne)

'On boucle ensuite sur toutes les vannes de la colonne C

Do Until ActiveCell = Me.cboVannemasquée 'tant que la cellule active n'est pas égale au N° de vanne choisi dans la liste déroulante cboVannemasquée
ActiveCell.Offset(-1, 0).Select 'on se décalle d'une ligne vers le haut pour la trouver
Loop

'On récupère ensuite les infos du fichier dans le formulaire et le curseur se positionne ensuite dans la TextBox Intervenant
Me.txtDate = ActiveCell.Offset(0, -2)
Me.txtPilote = ActiveCell.Offset(0, -1)
Me.txtDrive = ActiveCell.Offset(0, 2)
Me.txtFuite = ActiveCell.Offset(0, 3)
Me.txtRétroON = ActiveCell.Offset(0, 4)
Me.txtRétroOFF = ActiveCell.Offset(0, 5)
Me.txtCommentaire = ActiveCell.Offset(0, 6)

Dans votre dernier fichier, la combobox est alimentée sans condition.
Je vais donc à nouveau essayer de comprendre votre code et voir si celui-ci peut être adapté en fonction de cette condition sur la combobox.

Bien à vous deux,
Titoo

BOISGONTIER · 26 Février 2020

Après avoir chargé la ListBox, il suffit d'ajouter:

VB:

   temp = Me.ListBox1.List
   Tri temp, 1, UBound(temp), 0
   Me.ListBox1.List = temp

Boisgontier

DELHOMME · 26 Février 2020

Pour être vraiment sûr d'avoir compris...

BOISGONTIER à dit:
Après avoir chargé la ListBox, il suffit d'ajouter:

1) "chargé" pour vous, veut dire "écrit" pour moi tel que je l'ai présenté dans la fin de mon code ?

'On écrit dans la listBox
Me.ListBox1.AddItem Cells(x, 1)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Cells(x, 2)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = Cells(x, 3)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = Cells(x, 4)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = Cells(x, 5)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = Cells(x, 6)

End If
Next x
End Sub

2) Si oui, où dois-je insérer cet ajout ?
3) Comment dois-je définir ma fonction de Tri afin d'éviter une erreur de compilation ?

Merci pour vos retours Jacques.
Bien à vous,
Titoo

BOISGONTIER · 26 Février 2020

Après le Next x

VB:

   temp = Me.ListBox1.List
   Tri temp, Lbound(temp), UBound(temp), Lbound(temp)  ' si tri  1ere colonne'
   Me.ListBox1.List = temp

Boisgontier

DELHOMME · 27 Février 2020

Bonjour,

Merci pour votre retour.
J'ai mis en place le code mais j'ai malheureusement une erreur de compilation (sub ou fonction non définie) pointée sur la mise en place de ce nouveau code.
Quelques pistes pour que je puisse identifier le problème ?
Merci.
Bien à vous.

BOISGONTIER · 27 Février 2020

Bonjour,

Il doit manquer la procédure tri()

VB:

Sub Tri(a, gauc, droi, colTri)             ' 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 c = LBound(a, 2) To UBound(a, 2)
         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 Call Tri(a, g, droi, colTri)
If gauc < d Then Call Tri(a, gauc, d, colTri)
End Sub

Boisgontier

XL 2019 Tri automatique d'une listbox après filtrage dans une combobox

DELHOMME

XLDnaute Nouveau

Pièces jointes

Dranreb

XLDnaute Barbatruc

Pièces jointes

BOISGONTIER

XLDnaute Barbatruc

Pièces jointes

DELHOMME

XLDnaute Nouveau

BOISGONTIER

XLDnaute Barbatruc

Pièces jointes

Dranreb

XLDnaute Barbatruc

DELHOMME

XLDnaute Nouveau

BOISGONTIER

XLDnaute Barbatruc

DELHOMME

XLDnaute Nouveau

BOISGONTIER

XLDnaute Barbatruc

DELHOMME

XLDnaute Nouveau

Pièces jointes

BOISGONTIER

XLDnaute Barbatruc

Discussions similaires