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

DELHOMME

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

Pièces jointes

  • Création - Formulaire vannes masquées - version 9.xlsm
    50.7 KB · Affichages: 34

Dranreb

XLDnaute Barbatruc
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.
 

Pièces jointes

  • FormsTab.xlsm
    220.7 KB · Affichages: 40
Dernière édition:

DELHOMME

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

XLDnaute Barbatruc
Repose en paix
Voici un exemple avec un ComboBox et une ListBox


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
 

Pièces jointes

  • FormTriListBoxMultiCol.xlsm
    31.6 KB · Affichages: 63
Dernière édition:

DELHOMME

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

DELHOMME

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

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
 

DELHOMME

XLDnaute Nouveau
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.
 

Pièces jointes

  • Création - Formulaire vannes masquées - version 10.xlsm
    56 KB · Affichages: 36

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
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
 

Discussions similaires

Réponses
4
Affichages
165
Réponses
17
Affichages
759
Réponses
1
Affichages
119