Tri listbox par date VBA

Version imprimable

12/10/2016, 11h54
Mél3790

Tri listbox par date VBA

Bonjour le Forum,

Tout est dans le titre, je souhaiterais connaitre la façon de trier automatiquement une listbox par date, une fois que les items se chargent d'après un choix d'une combobox svp.

Merci beaucoup

combien de colonne a ta listbox?? 1 ou plusieurs

un exemple sur 1 colonne

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Private Sub tri_listbox_by_date()
    Dim tableau, tabl, i, a, e
    tableau = ListBox1.List()
    ReDim tabl(UBound(tableau))
    For i = 0 To UBound(tableau)
        For e = 0 To UBound(tableau)
            elem = tableau(e, 0)
            If tableau(i, 0) > tableau(e, 0) Then tableau(e, 0) = tableau(i, 0): tableau(i, 0) = elem
        Next e
    Next i
    a = 0
    For i = UBound(tableau) To 0 Step -1
        tabl(a) = tableau(i, 0)
        a = a + 1
    Next
    ListBox1.List = tabl
End Sub

12/10/2016, 14h20
joe.levrai

Bonjour,

il est, je pense, opportun de préciser quel type de tri tu souhaites ?

- un tri chronologique ? Donc on trie sur les numéros de série des dates
- un tri d'affichage ? On trie sur les Chaines de caractères "d'affichage" du format de date

Ca peut sembler bête ce que je dis, mais prenons simplement l'option 2.
Si tu affiches tes dates en format anglais, le tri d'affichage ne sera pas le même que le tri des dates en affichage "français"
12/10/2016, 15h27
Mél3790

Excusez-moi pour le manque de précisions.

C'est une listbox multicolonnes. Le tri doit s'établir sur la colonne 9 de la listbox. Cette colonne 9 contient des dates JJ/MM/AAAA. Il s'agit donc de faire un tri chronologique.
Merci.
12/10/2016, 15h50
boisgontierjacques

1 pièce(s) jointe(s)

Bonjour,

Exemple en PJ

Boisgontier

Désolé, mais cela ne m'aide pas beaucoup, où je ne sais pas adapter (je ne suis pas une experte en VBA)....

De plus, si la listbox est vide, il ne faut pas que la macro plante et bloque l'application, mais que le programme continue de fonctionner

j'ai adapté mon tri comme cele :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 Function listbox1() .... Dim a() a = Me.ListBox1.List NbCol = UBound(a, 2) - LBound(a, 2) + 1 Call tri(a(), LBound(a), UBound(a), NbCol, 1) Me.ListBox1.List = a End Function Sub tri(a(), gauc, droi, NbCol, 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 = 0 To NbCol - 1 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, NbCol, colTri) If gauc < d Then Call tri(a, gauc, d, NbCol, colTri) End Sub
Par contre j'ai un message d'erreur (" Erreur d'exécution 9 : L'indice n'appartient pas à la sélection") si je recherche un nom dans ma combobox et que la listbox n'affiche rien (selon la recherche il est parfois normal que la listbox soit vide).

Mais comment passer outre ce problème ?

Merci

Bonjour
des solutions il y en a des tas

je me suis un peu amusé avec les fonctions natives VBA

sur une plage de 5 colonnes avec les dates en colonnes 1 ,il te serait facile d'adapter cela a ton besoins

voila ce qu'il y a comme code dans mon userform avec une listbox et 1 bouton
j'ai largement commenté pour que cela soit intelligible

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
 
Private Sub CommandButton1_Click()
    Dim tabl1, tabl2, i%, e%, c%, h%
    tabl1 = ListBox1.List: ReDim tabl2(ListBox1.ListCount, ListBox1.ColumnCount + 1)
    'récupérer une colonne d'un tableau dans un array a 1 dimention
    coldate = Application.Transpose(Application.Index(tabl1, , 1))    'on transforme la colonne des dates en array 1 dimention
    For i = 1 To UBound(coldate): coldate(i) = CLng(CDate(coldate(i))): Next    'on transforme les dates en valeur  long
    For c = 1 To UBound(coldate)
        ind = WorksheetFunction.Match(WorksheetFunction.Min(coldate), coldate, 0) 'on recupere l'index de la dates la plus petite
        For e = 0 To ListBox1.ColumnCount - 1: tabl2(h, e) = tabl1(ind - 1, e): Next  'on remplie la nouvelle ligne du tabl2 de remplacement
        coldate(ind) = "*"    'on remplace la dates passée pour ne pas retomber dessus
        h = h + 1    'incrementation de la ligne du tableau de remplacement
    Next c
    ListBox1.List = tabl2
End Sub
 
 
Private Sub UserForm_Activate()
    ListBox1.List = Range(Cells(1, 1), Cells(Rows.Count, 5).End(xlUp)).Value    ' on remplie la listbox avec la plage voulue 
End Sub

voila

En essayant ton code, j'ai un message erreur d’exécution "objet requis".
Je ne sais pas si c'est à cause de ce code que je n'utilise pas :

Code:

ListBox1.List = Range(Cells(1, 1), Cells(Rows.Count, 5).End(xlUp)).Value

Car j'alimente ma listbox d'une autre façon :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
Function Listbox1()
 
 
If OptionButton5.Value = True Then
    lefiltre = "Toutes"
Else
If OptionButton6.Value = True Then
    lefiltre = "Planifier"
Else
If OptionButton7.Value = True Then
    lefiltre = "Annuler"
Else
If OptionButton8.Value = True Then
    lefiltre = "Réaliser"
Else
If OptionButton9.Value = True Then
    lefiltre = "A Programmer"
Else
End If
End If
End If
End If
End If
 
'Combobox1 = Liste de personne
 
Dim col As Byte
Dim lign As Long, drlig As Long
If Combobox1 = "" Then Exit Function 
ListBox1.Clear
With Workbooks("Formations.xlsm").Worksheets("Personnel").range("A:e")
drlig = Workbooks("Formations.xlsm").Worksheets("Personnel").range("e" & Workbooks("Formations.xlsm").Worksheets("Personnel").Rows.Count).End(xlUp).Row
 
    If lefiltre = "Toutes" Then
        For lign = 1 To drlig
            If .Cells(lign, 8) = Combobox1 Then
                ListBox1.AddItem .Cells(lign, 1)
                For col = 1 To 9
                    If col = 7 Then
                        ListBox1.List(ListBox1.ListCount - 1, col) = .Cells(lign, 19)
                    Else
                        ListBox1.List(ListBox1.ListCount - 1, col) = .Cells(lign, col + 1)
                    End If
                Next col
            End If
        Next lign
    Else
        For lign = 1 To drlig
            If .Cells(lign, 8) = Combobox1 And .Cells(lign, 16) = lefiltre Then
                ListBox1.AddItem .Cells(lign, 1)
                For col = 1 To 9
                    If col = 7 Then
                        ListBox1.List(ListBox1.ListCount - 1, col) = .Cells(lign, 19)
                    Else
                        ListBox1.List(ListBox1.ListCount - 1, col) = .Cells(lign, col + 1)
                    End If
                Next col
            End If
        Next lign
     End If
End With
End function

Et dans ton code, quels sont les 1 que je dois remplacer par mon numéro de colonne ?

re

Citation:

Et dans ton code, quels sont les 1 que je dois remplacer par mon numéro de colonne ?

voila la bonne question!!

la réponse c'est uniquement la ligne 6

bien sur je n'ai pas mis tes conditions a toi d'adapter

mais si su change le 1 en ligne 6 sur le coldate et que tu a bien 9 colonne normalement tu devrais remplacer le 1 par 9
voila

résultat instantané sur 2000 dates

heu... ton code remplissage heu... comment dire heu.....

je vais regarder cela afin de nettoyer mais sans fichier exemple c'est pas facile

je reviens

regarde un peu ce que tu fais!
tu commence comme ca
Code:

1 2 With Workbooks("Formations.xlsm").Worksheets("Personnel").Range("A:e") drlig = Workbooks("Formations.xlsm").Worksheets("Personnel").Range("e" & Workbooks("Formations.xlsm").Worksheets("Personnel").Rows.Count).End(xlUp).Row
puis dans ton remplissage dans tes boucles tu fais
Code:

1 2 3 4 5 6 7 8 '.....blablabla '.....blablabla '.....blablabla Listbox1.List(Listbox1.ListCount - 1, col) = .Cells(lign, 19) End With End Function
ce qui correspond a dire

Citation:

Listbox1.List(Listbox1.ListCount - 1, col) = Workbooks("Formations.xlsm").Worksheets("Personnel").Range("A:e").Cells(lign, 19)

tu crois pas que l'on a un soucis la ???????

depuis quand une plage de 5 colonnes contient une 19 Emme colonnes ?????????

c'est pas étonnant que tu ai une erreur d'object !!!!!!

Le numéro 19 correspond à ma colonne "N°index unique" qui me permet de récupérer la ligne sélectionner dans la listbox puis de remplir les textbox et combobox avec la méthode activecell.offset.

Effectivement, il était inutile d'écrire :

Code:

1
2
With Workbooks("Formations.xlsm").Worksheets("Personnel").Range("A:e")
drlig = Workbooks("Formations.xlsm").Worksheets("Personnel").Range("e" & Workbooks("Formations.xlsm").Worksheets("Personnel").Rows.Count).End(xlUp).Row

J'ai rectifié comme ceci :

Code:

1
2
With Workbooks("Copie Préparation Plan de Formations 2017.xlsm").Worksheets("tFicDuPersonnel")
drlig = Workbooks("Copie Préparation Plan de Formations 2017.xlsm").Worksheets("tFicDuPersonnel").range("A" & Workbooks("Copie Préparation Plan de Formations 2017.xlsm").Worksheets("tFicDuPersonnel").Rows.Count).End(xlUp).Row

.

Tout fonctionne parfaitement.

J'ai modifié mon numéro de colonne dans le code que tu m'as fourni. La ligne en gras dans le code m'indique une erreur incompatibilité de type :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub CommandButton2_Click()
Dim tabl1, tabl2, i%, e%, c%, h%
    tabl1 = ListBox3.List: ReDim tabl2(ListBox3.ListCount, ListBox3.ColumnCount + 1)
    'récupérer une colonne d'un tableau dans un array a 1 dimention
    coldate = Application.Transpose(Application.Index(tabl1, , 9))    'on transforme la colonne des dates en array 1 dimention
    For i = 1 To UBound(coldate): coldate(i) = CLng(CDate(coldate(i))): Next    'on transforme les dates en valeur  long
    For c = 1 To UBound(coldate)
        ind = WorksheetFunction.Match(WorksheetFunction.Min(coldate), coldate, 0) 'on recupere l'index de la dates la plus petite
        For e = 0 To ListBox3.ColumnCount - 1: tabl2(h, e) = tabl1(ind - 1, e): Next  'on remplie la nouvelle ligne du tabl2 de remplacement
        coldate(ind) = "*"    'on remplace la dates passée pour ne pas retomber dessus
        h = h + 1    'incrementation de la ligne du tableau de remplacement
    Next c
    ListBox3.List = tabl2
End Sub