[XL-2007] filtrer une colonne par date en VBA

filtrer une colonne par date en VBA

Bonjour les développeurs,

Je voudrais savoir comment puis-je filtrer une colonne par date?
Il s'agit d'une colonne contenant des dates de format texte (dd/mm/AAAA) et je veux afficher les dates antérieures à une certaine date en utilisant un filtre.

Toute aide serait bien apprécié.

Merci pour l'ame charitable qui pourrait m'aider

Bonjour PierreTark,

J'ai réalisé ce bout de code, qui me permet de sélectionner toute une plage de valeur entre deux dates.

Il marche sur Excel 2003,
à toi de le modifier, en retirant la partie qui ne te convient pas.

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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
Sub Total()

DateCherchée = InputBox("Date cherchée ! Format jj/mm/aaaa hh:mm:ss", "", Range("B2"))
If DateCherchée = "" Then Exit Sub
Ligne = 2
ColonneRecherche = 2
'DAteCellule = Cells
'On décompose "DateCherchée" qui est sous forme de texte, afin de le re concaténer sous la forme d'une vrai date
DD = Day(DateCherchée)
MM = Month(DateCherchée)
YYYY = Year(DateCherchée)
HH = Hour(DateCherchée)
MIM = Minute(DateCherchée)
SS = Second(DateCherchée)

Date_ = DateValue(DD & "/" & MM & "/" & YYYY)
Heure_ = TimeValue(HH & ":" & MIM & ":" & SS)
DateCherchée = Date_ + Heure_

Nb_Lignes_max = Range("B2").End(xlDown).Row         'Où "B2" est la colonne sur laquelle sont indiquées les dates

'Boucle sur les dates avec passage à la ligne suivante...
While DateCherchée <> Cells(Ligne, ColonneRecherche) _
    And Ligne <= Nb_Lignes_max
    Ligne = Ligne + 1
Wend

If Ligne > Nb_Lignes_max Then       'Message d'alerte si dépassement de la plage de date
    MsgBox ("Valeur non trouvée !")
Else
    MsgBox (Ligne)      'Numéro de la ligne où a été trouvé le résultat
End If

PremiereLigne = Ligne

''''''''''''''''''''''''''''''''

DateCherchée = InputBox("Date cherchée ! Format jj/mm/aaaa hh:mm:ss", "", Range("B2"))
If DateCherchée = "" Then Exit Sub
Ligne = PremiereLigne       'La ligne de départ est la ligne où est marquée
                '"DateCherchée" du Sub précédent
ColonneRecherche = 2


DD = Day(DateCherchée)
MM = Month(DateCherchée)
YYYY = Year(DateCherchée)
HH = Hour(DateCherchée)
MIM = Minute(DateCherchée)
SS = Second(DateCherchée)

Date_ = DateValue(DD & "/" & MM & "/" & YYYY)
Heure_ = TimeValue(HH & ":" & MIM & ":" & SS)
DateCherchée = Date_ + Heure_

Nb_Lignes_max = Range("B2").End(xlDown).Row

While DateCherchée <> Cells(Ligne, ColonneRecherche) _
    And Ligne <= Nb_Lignes_max
    Ligne = Ligne + 1
Wend

If Ligne > Nb_Lignes_max Then
    MsgBox ("Valeur non trouvée !")
Else
    MsgBox (Ligne)
End If

DerniereLigne = Ligne

'''''''''''''''''''''''''''''''''''
'On cache les lignes Antérieures à la Date de Début

    Ligne_Départ = 2
    Ligne_Fin = PremiereLigne - 1        'Correspond au numéro de ligne renvoyé par la MsgBox1
    Cellules = Ligne_Départ & ":" & Ligne_Fin
    Rows(Cellules).Hidden = True    
 'On cache les lignes Postérieures à la Date de Fin
 
    Ligne_Départ = DerniereLigne          'Correspond au numéro de ligne renvoyé par la MsgBox2
    Ligne_Fin = Range("B2").End(xlDown).Row
    Cellules = Ligne_Départ & ":" & Ligne_Fin
    Rows(Cellules).Hidden = True
End Sub

J'ai mis en roue les parties qui me semblent être moins intéréssante pour ton cas, mais j'ai mis le code entier au cas où ça aiderait quelqu'un.

Bonne continuation

Code:

1
2
3
4
5
6
Sub Macro1()
Dim DateRepere As Date
 
DateRepere = DateSerial(2011, 7, 12)              '12/07/2011
Worksheets("Feuil1").Range("A:A").AutoFilter Field:=1, Criteria1:="<" & CLng(DateRepere)
End Sub

Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 sub macro() dim i as Integer dim c as Long dim madate as Date For i = ... To ... madate = FormatDateTime(Cells(i, "...").Value) If madate >= DateValue("../../....") And madate <= DateValue("../../....") Then c = c + 1 'compteur range("...:..." &c).select end if next i end sub
Jeune codeur vba je te propose modestement ce petit bout de code ^^ tu ajoutes juste une condition qd le test est faux et une réinitialisation de ton compteur et ça doit le faire!

A toi de l'adapter à tes besoins :)