Filtre sur date dans un listbox

**counterbob** · 16/04/2017, 12h03

Bonjour

Dans un userform j'ai une listbox qui est alimentée par deux combobox les sources sont colonne B et C , je souhaite créer un filtre sur la colonne D sur le choix de l'année.
J'ai donc créé des CheckBox avec pour action le code des filtres par année.
Pour le CheckBox2016 ça fonctionne mais pas pour CheckBox2017

les filtres se font sur la feuille mais pas sur la lisbox.

Une piste ?
Merci
Cordialement

Codes des CheckBox

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub CheckBox2016_Change()
'filtre 2016
    Me.ListBox1.Clear
    If CheckBox2016 = True Then
        Sheets("BD").Select
    ActiveSheet.Range("$A$1:$J$3000").AutoFilter Field:=4, Criteria1:= _
        ">=01/01/2016", Operator:=xlAnd, Criteria2:="<=12/31/2016"
 
        Else
        Sheets("BD").Select
ActiveSheet.Range("$A$1:$J$3000").AutoFilter Field:=4
 
    End If
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub CheckBox2017_Change()
'filtre 2017
Me.ListBox1.Clear
    If CheckBox2017 = True Then
        Sheets("BD").Select
    ActiveSheet.Range("$A$1:$J$3000").AutoFilter Field:=4, Criteria1:= _
        ">=01/01/2017", Operator:=xlAnd, Criteria2:="<=12/31/2017"
 
        Else
        Sheets("BD").Select
ActiveSheet.Range("$A$1:$J$3000").AutoFilter Field:=4
 
    End If
End Sub

Le code des combobox

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub ComboBox2_click()
'Filtre colonne B
'ComboBox1 = ""
  ComboBox3 = ""
  Me.ListBox1.Clear
  For k = 1 To Ncol: Me("textBox" & k) = "": Next k
  j = 0
  n = Application.CountIf(Application.Index(Rng, , 2), Me.ComboBox2) 'colonne B
  Dim b()
  ReDim b(1 To n, 1 To Ncol + 1)
  For i = LBound(BD) To UBound(BD)
    If Me.ComboBox2 = BD(i, 2) Then
      j = j + 1
      For k = 1 To Ncol
        b(j, k) = BD(i, k)
        If k >= 3 And k <= 5 Then
        b(j, k) = BD(i, k)
        End If
      Next k
      b(j, k) = i
    End If
   Next i
   ListBox1.List = b 'alimente listbox1
   ListBox1.ListIndex = 0
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub ComboBox3_click()
'Filtre colonne C
  'ComboBox1 = ""
  ComboBox2 = ""
  Me.ListBox1.Clear
  For k = 1 To Ncol: Me("textBox" & k) = "": Next k
  j = 0
  n = Application.CountIf(Application.Index(Rng, , 3), Me.ComboBox3) 'colonne C
  Dim b()
  ReDim b(1 To n, 1 To Ncol + 1)
  For i = LBound(BD) To UBound(BD)
    If Me.ComboBox3 = BD(i, 3) Then
      j = j + 1
      For k = 1 To Ncol
        b(j, k) = BD(i, k)
        If k >= 3 And k <= 5 Then
        b(j, k) = BD(i, k)
        End If
      Next k
      b(j, k) = i
    End If
   Next i
   ListBox1.List = b 'alimente listbox1
   ListBox1.ListIndex = 0
End Sub

Nom : apercu.JPG
Affichages : 1454
Taille : 30,0 Ko

**Philippe Tulliez** · 16/04/2017, 13h55

Bonjour,
J'avoue que ce n'est pas très clair.
D'abord ton titre évoque un contrôle ListBox or les codes que tu affiches montrent clairement que tu utilises des contrôles ComboBox

Tu souhaites filtrer la feuille ou uniquement la liste du ComboBox ?
Autre question, pourquoi deux ComboBox l'un avec 2016 et l'autre 2017, Y a t'il une raison ?

Si tu souhaites avoir deux ComboBox avec 2016 à gauche et 2017 à droite, il suffit de parcourir la liste des données et comparer l'année de la date et d'utiliser la méthode AddItem afin de placer les bonnes informations à gauche ou à droite.

Question supplémentaire, faut-il récupérer l'enregistrement de la ligne sélectionnée dans l'un ou l'autre ComboBox ?

Cette réponse dans la discussion ayant pour titre "Remplissage listbox sous condition" t'aidera peu-être

Autre discussion avec deux ListBox contenant l'un les personnes de sexe féminin et l'autre celles de sexe masculin
Il y a un fichier exemple à télécharger https://www.developpez.net/forums/d1...s/#post8275338

**boisgontierjacques** · 16/04/2017, 14h56

Bonjour,

Avec le fichier en PJ, il n'y aurait plus d'ambiguïté.

Boisgontier
http://boisgontierjacques.free.fr

**counterbob** · 16/04/2017, 16h48

Oui effectivement j'ai essayé d'adapter cet excellent formulaire http://boisgontierjacques.free.fr/fi...ifCreation.xls
dont vous êtes l'auteur. je tenais à vous remercier pour ces réalisations d'un grand secours.
Mais je bloque pour intégrer la recherche entre deux dates de ma colonne D sur ce formulaire.
J'ai donc essayé de faire des filtres par année associés à des checkbox.
Mais ça fonctionne que pour 2016.

Merci
Cordialement

**counterbob** · 16/04/2017, 17h04

Envoyé par Philippe Tulliez

Bonjour,
J'avoue que ce n'est pas très clair.
D'abord ton titre évoque un contrôle ListBox or les codes que tu affiches montrent clairement que tu utilises des contrôles ComboBox

Tu souhaites filtrer la feuille ou uniquement la liste du ComboBox ?
Autre question, pourquoi deux ComboBox l'un avec 2016 et l'autre 2017, Y a t'il une raison ?

Si tu souhaites avoir deux ComboBox avec 2016 à gauche et 2017 à droite, il suffit de parcourir la liste des données et comparer l'année de la date et d'utiliser la méthode AddItem afin de placer les bonnes informations à gauche ou à droite.

Question supplémentaire, faut-il récupérer l'enregistrement de la ligne sélectionnée dans l'un ou l'autre ComboBox ?

Cette réponse dans la discussion ayant pour titre "Remplissage listbox sous condition" t'aidera peu-être

Autre discussion avec deux ListBox contenant l'un les personnes de sexe féminin et l'autre celles de sexe masculin
Il y a un fichier exemple à télécharger https://www.developpez.net/forums/d1...s/#post8275338

Bonjour

Je vais essayer de répondre clairement.

1. La listebox est modifiée par les combobox d'où ces codes.
2. Je souhaite filtrer la feuille et que la listebox soit mise à jour avec ce filtre lorsque je fais un choix dans l'un des combobox (une nouvelle liste de données en fait).

Si tu souhaites avoir deux ComboBox avec 2016 à gauche et 2017 à droite, il suffit de parcourir la liste des données et comparer l'année de la date et d'utiliser la méthode AddItem afin de placer les bonnes informations à gauche ou à droite.

3. Je souhaite que la liste de données soit les références de valeur de recherche. 2016,2017,2018,2019 etc.

J'avais donc à l'esprit de créer des filtres .

J'espère avoir été précis
Merci

**Philippe Tulliez** · 17/04/2017, 10h15

Bonjour,
As-tu regardé les deux liens que j'ai publié ?
Il suffit de t'en inspirer pour alimenter le ListBox la condition dans ton cas devant être réglé par un ou plusieurs And et certainement la fonction Year pour extraire l'année des dates.

**boisgontierjacques** · 17/04/2017, 14h36

Bonjour,

Exemple de filtre sur année avec affichage dans ListBox.
Les dates sont en colonne D.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Private Sub UserForm_Initialize()
  Set f = Sheets("bd")
  Set d = CreateObject("Scripting.Dictionary")
  bd = f.Range("A2:D" & f.[A65000].End(xlUp).Row).Value
  Tri bd, LBound(bd), UBound(bd), 4  ' version tri
  Me.ListBox1.List = bd
  For i = LBound(bd) To UBound(bd)
     d(Year(bd(i, 4))) = ""
  Next i
  Me.ComboBox1.List = d.keys
  Me.ListBox1.ColumnCount = 4
  Me.ListBox1.ColumnWidths = "50;30;50;30"
End Sub
 
Private Sub ComboBox1_click()
  an = Val(Me.ComboBox1): n = 0
  Dim Tbl()
  For i = 1 To UBound(bd)
    If Year(bd(i, 4)) = an Then
        n = n + 1: ReDim Preserve Tbl(1 To UBound(bd, 2), 1 To n)
        For k = 1 To UBound(bd, 2): Tbl(k, n) = bd(i, k): Next k
     End If
  Next i
  If n > 0 Then Me.ListBox1.Column = Tbl Else Me.ListBox1.Clear
End Sub

Boisgontier

**counterbob** · 17/04/2017, 17h29

Bonjour
merci
j'ai adapté au formulaire.
La liste par année choisie s'affiche dans listbox.
il me reste a réaliser le deuxième critère Colonne B (Ville)
Critère 1 = année
Critère 2 = Colonne B (Ville)

Merci encore

**boisgontierjacques** · 17/04/2017, 17h49

Exemple Date(col4) & ville(col3) en PJ

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Dim f, bd
Option Compare Text
Private Sub UserForm_Initialize()
  Set f = Sheets("bd")
  Set d = CreateObject("Scripting.Dictionary")
  bd = f.Range("A2:D" & f.[A65000].End(xlUp).Row).Value
  Tri bd, LBound(bd), UBound(bd), 4  ' version tri
  For i = LBound(bd) To UBound(bd)
     d(Year(bd(i, 4))) = ""
  Next i
  Me.ComboBox1.List = d.keys
  d.RemoveAll
  d("*") = ""
  Tri bd, LBound(bd), UBound(bd), 3  ' version tri
  For i = LBound(bd) To UBound(bd)
     d(bd(i, 3)) = ""
  Next i
  Me.ComboBox2.List = d.keys: Me.ComboBox2 = "*"
  Me.ListBox1.ColumnCount = 4
  Me.ListBox1.ColumnWidths = "50;30;50;30"
  Me.ListBox1.List = bd
End Sub
 
Private Sub ComboBox1_click()
  affiche
End Sub
 
Private Sub ComboBox2_click()
  affiche
End Sub
 
Sub affiche()
  an = Val(Me.ComboBox1)
  ville = Me.ComboBox2
  n = 0
  Dim Tbl()
  For i = 1 To UBound(bd)
    If Year(bd(i, 4)) = an And bd(i, 3) Like ville Then
        n = n + 1: ReDim Preserve Tbl(1 To UBound(bd, 2), 1 To n)
        For k = 1 To UBound(bd, 2): Tbl(k, n) = bd(i, k): Next k
     End If
  Next i
  If n > 0 Then Me.ListBox1.Column = Tbl Else Me.ListBox1.Clear
End Sub

Boisgontier

**counterbob** · 19/04/2017, 16h40

Merci

je vais essayé de l'écrire dans le code à appliquer.

Par contre il y a un autre problème sur le format date renvoyé à la validation d'une modif.
Les dates sont bien inscrites mais ne font pas partie du même format que les précédentes lors d'un filtre sur la feuille comme si ce n'était pas des dates.

Nom : filtredate.jpg
Affichages : 1439
Taille : 24,3 Ko

Nom : filtredate.jpg
Affichages : 1439
Taille : 24,3 Ko

Voici le code validation

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub b_modif_Click()
If Me.textbox1 = "" Then
    MsgBox ("Vous devez inscrire la date de demande.")
    Me.textbox1.SetFocus
 
    Else
    If Me.Enreg <> "" And Me.textbox1 <> "" Then
      NoEnreg = Me.Enreg
      For K = 1 To Ncol
        X = Replace(Me("textBox" & K), " ", "")
         If IsNumeric(X) Then
           f.Cells(NoEnreg, K) = Val(X)
           Else
           f.Cells(NoEnreg, K) = Me("textBox" & K)
 
         End If
      Next K
      raz
      Me.Enreg = ""
 
 
      Unload F_dates
      Unload F_calendrier2datesForm
      F_dates.Hide
      F_calendrier2datesForm.Hide
 
      UserForm_Initialize
    End If
    End If
End Sub

le textbox

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Private Sub textbox4_AfterUpdate()
textbox4.Value = Format(textbox4.Value, "mm/dd/yyyy")
If Not IsDate(textbox4) Then
        MsgBox "votre date n'est pas bonne"
 
End If

End Sub

J'ai essayé d'autre méthode vu sur ce site mais ça ne fonctionne pas.

merci pour l'aide

**counterbob** · 20/04/2017, 09h36

Bonjour je reviens vers vous car j'ai intégré le code
mais il y a une erreur code 13

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub UserForm_Initialize()
   Set f = Sheets("BD")
   Set Rng = f.Range("A2:N" & f.[A65000].End(xlUp).Row)
   BD = Rng.Value
   
  Set d = CreateObject("Scripting.Dictionary")
  BD = f.Range("A2:N" & f.[A65000].End(xlUp).Row).Value
  'Tri BD, LBound(BD), UBound(BD), 4  ' version tri
  Me.ListBox1.List = BD
  For i = LBound(BD) To UBound(BD)
        
     d(Year(BD(i, 4))) = ""
     
     
  Next i
  Me.ComboBox1.List = d.keys
  Me.ListBox1.ColumnCount = 14
   
   Ncol = Rng.Columns.Count
   Set dte = Range([D2], [A65536].End(xlUp))
   
   'Set D1 = CreateObject("Scripting.Dictionary")
   Set D2 = CreateObject("Scripting.Dictionary")
   Set d3 = CreateObject("Scripting.Dictionary")
   'D1.CompareMode = vbTextCompare
   D2.CompareMode = vbTextCompare
   d3.CompareMode = vbTextCompare
   For i = LBound(BD) To UBound(BD)
   
    'If Not D1.Exists(BD(i, 4)) Then D1(BD(i, 4)) = ""
    If Not D2.Exists(BD(i, 2)) Then D2(BD(i, 2)) = ""
    If Not d3.Exists(BD(i, 3)) Then d3(BD(i, 3)) = ""
   Next i
 
   temp = D2.keys
   Call Tri(temp, LBound(temp), UBound(temp))
   Me.ComboBox2.List = temp
   temp = d3.keys
   Call Tri(temp, LBound(temp), UBound(temp))
   Me.ComboBox3.List = temp
   Me.ListBox1.Clear
   
   Me.ComboBox1.ListIndex = -1
   Me.ComboBox2.ListIndex = -1
   Me.Enreg = f.[A65000].End(xlUp).Row + 1
   
   Me.ComboBox5.ColumnCount = 2
   Me.ComboBox5.ColumnWidths = "350,40"
   Me.ComboBox5.RowSource = "ceremonie"
   
    Me.Frame4.Visible = False
   F_calendrier2datesForm.Hide
End Sub

**counterbob** · 20/04/2017, 22h20

bonsoir

j'ai réussi à réaliser les filtres

merci

maintenant je cherche à effectuer un tri croissant sur la quatrième colonne de la listbox qui comprend des dates.

et aussi remplir les textbox lors de la sélection dans la listbox.
voici le code sur listebox1_click avec erreur argument non valide

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Private Sub ListBox1_Click()
    For K = 1 To Ncol
      Me("textBox" & K) = Me.ListBox1.Column(K - 1)
    Next K
    Me.Enreg = Me.ListBox1.Column(Ncol) + Rng.Row - 1
End Sub

Voici le code complet de userform

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
Dim f, bd, Ncol, Rng
 
Option Compare Text
 
Private Sub UserForm_Initialize()
  Set f = Sheets("bd")
  Set d = CreateObject("Scripting.Dictionary")
  bd = f.Range("A2:K" & f.[A65000].End(xlUp).Row).Value
 
  Set Rng = f.Range("A2:L" & f.[A65000].End(xlUp).Row)
  Ncol = Rng.Columns.Count
  'alimentation des combo 1 à 3
 
  Tri bd, LBound(bd), UBound(bd), 4  ' version tri date
  d("*") = ""
  For i = LBound(bd) To UBound(bd)
     d(Year(bd(i, 4))) = ""
  Next i
  Me.ComboBox1.List = d.keys:
  Me.ComboBox1 = "*"
  d.RemoveAll
 
  d("*") = ""
  Tri bd, LBound(bd), UBound(bd), 2  ' version tri col B
  For i = LBound(bd) To UBound(bd)
     d(bd(i, 2)) = ""
  Next i
  Me.ComboBox2.List = d.keys
  Me.ComboBox2 = "*"
  d.RemoveAll
 
  d("*") = ""
  'Tri bd, LBound(bd), UBound(bd), 3  ' version tri col C
  For i = LBound(bd) To UBound(bd)
     d(bd(i, 3)) = ""
 Next i
  Me.ComboBox3.List = d.keys
  Me.ComboBox3 = "*"
  d.RemoveAll
 
 
  Me.ListBox1.ColumnCount = 12
  Me.ListBox1.ColumnWidths = "50;100;250;50;30;50;80;50;30;30;200;100"
  Me.ListBox1.List = bd
End Sub
Private Sub ComboBox1_click()
  affiche
 End Sub
Private Sub ComboBox2_click()
  affiche
End Sub
Private Sub ComboBox3_click()
  affiche
End Sub
 
Sub affiche()
  If Me.ComboBox1 = "*" Then
  an = "*"
  Else: an = Val(Me.ComboBox1)
  ville = Me.ComboBox2
  cere = Me.ComboBox3
  n = 0
  End If
  Dim Tbl()
  For i = 1 To UBound(bd)
    If (Year(bd(i, 4)) = an Or an = "*") And bd(i, 2) Like ville And bd(i, 3) Like cere Then
        n = n + 1:
        ReDim Preserve Tbl(1 To UBound(bd, 2), 1 To n)
        For K = 1 To UBound(bd, 2):
        Tbl(K, n) = bd(i, K): Next K
     End If
  Next i
  If n > 0 Then
  Me.ListBox1.Column = Tbl
  Else:
    Me.ListBox1.Clear
   End If
 
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
 
 
Private Sub ListBox1_Click()
    For K = 1 To Ncol
      Me("textBox" & K) = Me.ListBox1.Column(K - 1)
    Next K
    Me.Enreg = Me.ListBox1.Column(Ncol) + Rng.Row - 1
End Sub

**boisgontierjacques** · 21/04/2017, 05h49

Bonjour,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
Private Sub ListBox1_Click()
  For i = 1 To UBound(bd, 2)
    Me("textbox" & i) = Me.ListBox1.Column(i - 1)
  Next i
End Sub

Boisgontier

**counterbob** · 21/04/2017, 11h42

excellent mais je ne comprend pas comment faire le tri croissant par date (colonne 4 du listbox1)

merci

**boisgontierjacques** · 21/04/2017, 12h25

Dans la procédure Initialize, il y a un tri du tableau BD(,) suivant la colonne 4

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
  Tri bd, LBound(bd), UBound(bd), 4  ' tri par date
  Me.ListBox1.List = bd

Boisgontier

**counterbob** · 21/04/2017, 13h10

Ok j'ai inversé l'ordre de tri les tris de colonne 2 et 4
en premier ville puis date
et c'est bon

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub UserForm_Initialize()
  Set f = Sheets("bd")
  Set d = CreateObject("Scripting.Dictionary")
  bd = f.Range("A2:K" & f.[A65000].End(xlUp).Row).Value
 
  Set Rng = f.Range("A2:L" & f.[A65000].End(xlUp).Row)
  Ncol = Rng.Columns.Count
  'alimentation des combo 1 à 3
 
   d("*") = ""
  Tri bd, LBound(bd), UBound(bd), 2  ' version tri col B
 For i = LBound(bd) To UBound(bd)
    d(bd(i, 2)) = ""
  Next i
 Me.ComboBox2.List = d.keys
  Me.ComboBox2 = "*"
  d.RemoveAll
 
 
 
 
  Tri bd, LBound(bd), UBound(bd), 4  ' version tri date
  d("*") = ""
  For i = LBound(bd) To UBound(bd)
     d(Year(bd(i, 4))) = ""
  Next i
  Me.ComboBox1.List = d.keys:
  Me.ComboBox1 = "*"
  d.RemoveAll
 
 
 
  d("*") = ""
  'Tri bd, LBound(bd), UBound(bd), 3  ' version tri col C
  For i = LBound(bd) To UBound(bd)
     d(bd(i, 3)) = ""
 Next i
  Me.ComboBox3.List = d.keys
  Me.ComboBox3 = "*"
  d.RemoveAll
 
 
  Me.ListBox1.ColumnCount = 12
  Me.ListBox1.ColumnWidths = "50;100;250;50;30;50;80;50;30;30;200;100"
  Me.ListBox1.List = bd
End Sub

Une question pourquoi (*) affiche toutes les lignes à l'initialisation et puis lorsque l'on choisi une année et que sélectionne de nouveau (*) dans combo année n'affiche rien ?

Filtre sur date dans un listbox [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager