Filtrer une date dans un tableau structuré

Version imprimable

Voir 40 message(s) de cette discussion en une page

Bonjour,

Il y a un truc incroyable avec la macro ci-dessous, je peux filtrer :

< qu'aujourd'hui
> qu'aujourd'hui
<= qu'aujourd'hui
>= qu'aujourd'hui
<> qu'aujourd'hui
= ne fonctionne pas, impossible de filtrer seulement aujourd'hui

Merci pour votre aide

Code:

1
2
3
4
5
6
7
8
9
10
11
Sub Bouton_Filtrer_Aujourdhui()
Dim La_Date As Long
Application.ScreenUpdating = False
    La_Date = DateSerial(Year(Date), Month(Date), Day(Date))
    Call Liberer_filtre_TS(Range("TS_Suivi"))
'    Call Filtrer_TS(Range("TS_Suivi"), "Intervention", 1, 11, 0) '1 = Aujourd'hui - 2 = Hier - 3 = Demain
'    Call Filtrer_TS(Range("TS_Suivi"), "Intervention", La_Date)
    ActiveSheet.ListObjects("TS_Suivi").Range.AutoFilter Field:=37, Criteria1:="=" & La_Date
'    ActiveWindow.ScrollRow = 1  'Jusqu'à la ligne
Application.ScreenUpdating = True
End Sub

10/05/2023, 22h08
Philippe Tulliez

Bonjour,
J'avais déjà constaté que le filtre automatique effectué manuellement sur les dates a également un étrange comportement avec la date d'aujourd'hui.
Si l'on sélectionne égal à et que l'on choisi dans le calendrier la date du jour ou Aujourd'hui, le filtre ne fonctionne pas alors que si l'on sélectionne Aujourd'hui cela fonctionne

Le code VBA généré par l'enregistreur de macros est d'ailleurs différent.
11/05/2023, 10h12
goninph

Il n'y a pas de solution, mon but est de filtrer hier, mais si on est lundi de filtrer vendredi et demain, mais si l'on est vendredi de filtrer lundi.
Pas facile lorsque la macro ne supporte pas la date du jour et en plus si Philippe Tulliez n'a pas la solution, je ne suis pas près de résoudre mon problème

Encore merci à tous
11/05/2023, 11h46
joe.levrai

Bonjour,

il faut utiliser Date pour filtrer sur la date du jour

Code:

ActiveSheet.ListObjects(1).Range.AutoFilter Field:=1, Criteria1:="=" & Date
11/05/2023, 11h50
Philippe Tulliez

Bonjour,

Citation:

si Philippe Tulliez n'a pas la solution, je ne suis pas près de résoudre mon problème

Attention, je n'ai pas dit qu'il n'y avait pas de solution. Il était tard hier soir et j'ai juste voulu signaler que manuellement le filtre automatique avait des problèmes de fonctionnement. Il a évidemment des solutions comme l'a suggéré Joe, que je salue au passage, et aussi en faisant référence à une cellule externe mais je n'avais pas le temps hier d'apporter une réponse et la tester.
11/05/2023, 20h54
goninph

La proposition de Joe ne fonctionne pas

Code:

ActiveSheet.ListObjects(1).Range.AutoFilter Field:=1, Criteria1:="=" & Date
11/05/2023, 20h59
goninph

Bonsoir,

Citation:

Envoyé par Philippe Tulliez

et aussi en faisant référence à une cellule externe mais je n'avais pas le temps hier d'apporter une réponse et la tester.

Pourriez-vous m'en dire plus ?

Merci pour votre aide

Hello,

Les 3 macros fonctionnent, reste plus qu'à éviter les weekends

Code:

1
2
3
4
5
6
7
8
9
10
Sub Bouton_Filtrer_Hier()
Dim La_Date As Long
Application.ScreenUpdating = False
    La_Date = DateSerial(Year(Date), Month(Date), Day(Date - 1))
    Call Liberer_filtre_TS(Range("TS_Suivi"))
'    Call Filtrer_TS(Range("TS_Suivi"), "Intervention", 1, 11, 0) '1 = Aujourd'hui - 2 = Hier - 3 = Demain
    ActiveSheet.ListObjects("TS_Suivi").Range.AutoFilter Field:=37, Criteria1:=">=" & La_Date, Criteria2:="<" & La_Date + 1
    ActiveWindow.ScrollRow = 1  'Jusqu'à la ligne
Application.ScreenUpdating = True
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
Sub Bouton_Filtrer_Aujourdhui()
Dim La_Date As Long
Application.ScreenUpdating = False
    La_Date = DateSerial(Year(Date), Month(Date), Day(Date))
    Call Liberer_filtre_TS(Range("TS_Suivi"))
'    Call Filtrer_TS(Range("TS_Suivi"), "Intervention", 1, 11, 0) '1 = Aujourd'hui - 2 = Hier - 3 = Demain
    ActiveSheet.ListObjects("TS_Suivi").Range.AutoFilter Field:=37, Criteria1:=">=" & La_Date, Criteria2:="<" & La_Date + 1
    ActiveWindow.ScrollRow = 1  'Jusqu'à la ligne
Application.ScreenUpdating = True
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
Sub Bouton_Filtrer_Demain()
Dim La_Date As Long
Application.ScreenUpdating = False
    La_Date = DateSerial(Year(Date), Month(Date), Day(Date + 1))
    Call Liberer_filtre_TS(Range("TS_Suivi"))
'    Call Filtrer_TS(Range("TS_Suivi"), "Intervention", 1, 11, 0) '1 = Aujourd'hui - 2 = Hier - 3 = Demain
    ActiveSheet.ListObjects("TS_Suivi").Range.AutoFilter Field:=37, Criteria1:=">=" & La_Date, Criteria2:="<" & La_Date + 1
    ActiveWindow.ScrollRow = 1  'Jusqu'à la ligne
Application.ScreenUpdating = True
End Sub

Pour éviter les weekends

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Bouton_Filtrer_Hier()
Dim La_Date As Long
Application.ScreenUpdating = False
    Call Liberer_filtre_TS(Range("TS_Suivi"))
    La_Date = DateSerial(Year(Date), Month(Date), Day(Date - 1))
    If Weekday(La_Date, vbMonday) > 5 Then ' Exclure les samedis et dimanches
        La_Date = DateSerial(Year(Date), Month(Date), Day(Date - 3))
        ActiveSheet.ListObjects("TS_Suivi").Range.AutoFilter Field:=37, Criteria1:=">=" & La_Date, Criteria2:="<" & La_Date + 1
    Else
        ActiveSheet.ListObjects("TS_Suivi").Range.AutoFilter Field:=37, Criteria1:=">=" & La_Date, Criteria2:="<" & La_Date + 1
    End If
    ActiveWindow.ScrollRow = 1  'Jusqu'à la ligne
Application.ScreenUpdating = True
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Bouton_Filtrer_Demain()
Dim La_Date As Long
Application.ScreenUpdating = False
    Call Liberer_filtre_TS(Range("TS_Suivi"))
    La_Date = DateSerial(Year(Date), Month(Date), Day(Date + 1))
    If Weekday(La_Date, vbMonday) > 5 Then ' Exclure les samedis et dimanches
        La_Date = DateSerial(Year(Date), Month(Date), Day(Date + 3))
        ActiveSheet.ListObjects("TS_Suivi").Range.AutoFilter Field:=37, Criteria1:=">=" & La_Date, Criteria2:="<" & La_Date + 1
    Else
        ActiveSheet.ListObjects("TS_Suivi").Range.AutoFilter Field:=37, Criteria1:=">=" & La_Date, Criteria2:="<" & La_Date + 1
    End If
    ActiveWindow.ScrollRow = 1  'Jusqu'à la ligne
Application.ScreenUpdating = True
End Sub

12/05/2023, 15h06
joe.levrai

Citation:

Envoyé par goninph

La proposition de Joe ne fonctionne pas

Code:

ActiveSheet.ListObjects(1).Range.AutoFilter Field:=1, Criteria1:="=" & Date

Bonjour,

proposition testée avant soumission et abondamment utilisée dans mes procédures.

Ton problème doit être ailleurs
12/05/2023, 16h15
laurent_ott

Citation:

Envoyé par joe.levrai

Code:

ActiveSheet.ListObjects(1).Range.AutoFilter Field:=1, Criteria1:="=" & Date

Bonjour,
Chez moi aussi ça ne fonctionne pas.
Et je dois passer par deux opérateurs pour sélectionner la date du jour (mise au format année/mois/jour), ce qui donne :
Criteria1:= ">=" & year(date) & "/" & month(date) & "/" & day(date)
Operator:= xlAnd
Criteria2:= "<=" & year(date) & "/" & month(date) & "/" & day(date)

Ma version Excel : Microsoft® Excel® 2016 MSO (16.0.14326.20706) 64*bits
12/05/2023, 17h30
goninph

Je pense que dateserial est meilleur que la mise en forme, voir mes 2 posts précédent

Qu'en pensez-vous ?
12/05/2023, 17h32
goninph

Pour info, les macros de mon post : "Pour éviter les WEEK-END" fonctionne à merveille

Bon week-end 😍

2 pièce(s) jointe(s)

Bonjour,

Citation:

Citation:

Citation Envoyé par Philippe Tulliez Voir le message
et aussi en faisant référence à une cellule externe mais je n'avais pas le temps hier d'apporter une réponse et la tester.

Pourriez-vous m'en dire plus ?

Semaine chargée, voici l'explication par rapport à ma réponse de jeudi

J'ai tendance à toujours privilégier ce qui est natif dans Excel et utiliser les cellules de celui-ci comme paramètres et n'utiliser le VBA que pour la partie à automatiser ce qui a pour avantage de faciliter la maintenance et de ne plus toucher aux procédures

Ainsi la date à filtrer dans cet exemple se trouve dans une cellule nommée pCriteria et la cellule contenant la valeur permettant de calculer la date à filtrer (soit -1 pour hier, 0 pour aujourd'hui et 1 pour demain) se nomme pDateGap
La cellule pCriteria contient la formule

Code:

=FORMULETEXTE(pCriteria)

permettant ainsi de calculer les dates sans les week-end (on pourrait bien entendu ajouter les jours fériés)
La cellule nommée pDateGap est modifiée par les boutons

Pour la démonstration, J'ai figé la date du jour dans une formule nommée CurrentDate

Code de la procédure qui filtre la table
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Function FilterByDate(TableName As String, FieldName As String, SerialDate As Long) ' Autofiltre d'une date ' Arguments ' TableName Nom de la table à filter ' FieldName Nom de l'étiquette de colonne ' SerialDate N° de série de la date Dim l As ListObject Dim f As Integer Set l = Range(TableName).ListObject f = l.ListColumns(FieldName).Index l.Range.AutoFilter Field:=f, _ Criteria1:=">=" & SerialDate, _ Operator:=xlAnd, _ Criteria2:="<=" & SerialDate Set l = Nothing End Function
Code de la procédure qui l'invoque et modifie la cellule pDateGap
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 Sub OnAction() Const t As String = "t_Data" ' Nom de la table Const l As String = "Date" ' Colonne à filtrer Const c As String = "pCriteria" ' Cellule contenant la date à filtrer Const g As String = "pDateGap" ' Cellule contenant l'écart Dim b As String Dim e As Integer Dim f As Boolean b = Application.Caller Select Case b Case "btnYesterday": e = -1 Case "btnToday": e = 0 Case "btnTomorrow": e = 1 Case "btnClearFilter": f = True Case Else MsgBox "Le bouton [" & b & "] n'est associé à aucune procédure" End Select If f Then Range(t).ListObject.AutoFilter.ShowAllData Else Range(g).Value = e FilterByDate t, l, Range(c).Value End If End Sub
Amélioration
On pourrait réduire cette procédure et augmenter les possibilités de filtrage avec les jours, semaines et mois, etc. en créant une table à deux colonnes (Texte + Ecart) en sélectionnant la date à filtrer par une liste déroulante dont la source serait cette table.
L'appel à la procédure FilterByDate serait faite alors par la procédure événementielle Worksheet_SelectionChange

Illustration

Pièce jointe 638626

13/05/2023, 12h24
laurent_ott

2 pièce(s) jointe(s)
Citation:

Envoyé par Philippe Tulliez

J'ai tendance à toujours privilégier ce qui est natif dans Excel et utiliser les cellules de celui-ci comme paramètres et n'utiliser le VBA que pour la partie à automatiser ce qui a pour avantage de faciliter la maintenance et de ne plus toucher aux procédures

Je me suis amusé a trouver une solution en utilisant au maximum les ressources natives d'Excel et la programmation en dernier recours.

Pièce jointe 638636

Formules (vous pouvez faire autre chose pour les week-end mais je ne sais pas faire, je ne suis pas très bon en formules) :
E2 : =E3-1
E3 : =AUJOURDHUI()
E4 : =E3+1

F2 : une case à cocher (j'ai supprimé le texte) qui a comme cellule liée F2
idem pour F3 et F4
F5 : =NB.SI(F2:F4;VRAI) pour compter le nombre de cases à cocher qui sont cochées. On s'en sert pour la suite.
G2 : =SI(OU($F$5=0; F2=VRAI);"x";"")
Explication : si aucune case est cochée ou si F2 est cochée alors on renvoie "x", sinon on renvoie vide.
idem pour G3 et G4

Dans le tableau structuré qui contient les données (que j'ai nommé "Tableau_Action") j'ai ajouté une colonne "Sel" avec une formule qui renvoie "x" si aucune case n'est cochée (on veut tout sélectionner), ou si la case de la date est cochée :
=SI($F$5>0;RECHERCHEV([@Journée];$E$2:$G$4;3;VRAI);"x")
Et j'ai mis un filtre textuel sur la colonne : Contient = x

Vous pouvez masquer la colonne G et mettre en couleur blanche le texte des cellules F2 à F5 pour un meilleur rendu.
L'utilisateur coche les cases de son choix pour filtrer une, deux ou trois dates, ou ne coche rien pour afficher toutes les dates.
Et clique sur "Réappliquer" (menu Données) pour actualiser le filtre (quand le tableau est sélectionné)

La programmation intervient ici, pour faire une actualisation automatique du tableau à chaque clic sur une case à cochée avec un événement sur "Calcul" (car F5 est recalculé à chaque fois qu'une case est cochée ou décochée) :
Code:

1 2 3 4 5 Private Sub Worksheet_Calculate() Application.EnableEvents = False ActiveSheet.ListObjects("Tableau_Action").AutoFilter.ApplyFilter Application.EnableEvents = True End Sub
Pièce jointe 638637

Voilà. Ca ne sert pas à grand-chose, mais ça montre que c'est faisable avec un minimum de programmation, voire pas du tout.
Bonne continuation.
13/05/2023, 12h47
Philippe Tulliez

Bonjour Laurent,
Encore mieux comme solution sans VBA effectivement mais j'étais parti sur l'usage de la récupération de dates dans une fonction d'excel en utilisant le filtre.
Mon idée de départ était d'avoir uniquement la fonction filtrant et la procédure événementielle réagissant à la sélection dans une liste déroulante. Ce sera pour un prochain billet dans mon blog.

[EDIT]
Attention, Il y a un bug, si l'on supprime le filtre
13/05/2023, 13h56
goninph

Merci à tous
13/05/2023, 17h09
Philippe Tulliez

1 pièce(s) jointe(s)

Bonjour,
La marche porte conseil, si nous partons sur le fait d'ajouter une colonne à la table, il y a plus simple. Sans VBA et avec un segment

Avec dans la colonne période la formule

Code:

=SI(ABS(CurrentDate-[@Date])<2;CHOISIR(CurrentDate-[@Date] + 2;"Demain";"Aujourd'hui";"Hier");"")

Illustration

Pièce jointe 638641

Citation:

Envoyé par Philippe Tulliez

Attention, Il y a un bug, si l'on supprime le filtre

On peut résoudre le problème en VBA, et en profiter pour supprimer aussi les éventuels autres filtres posés par l'utilisateur, ça donne ceci :
Code:

1 2 3 4 5 6 7 Private Sub Worksheet_Calculate() Application.EnableEvents = False On Error Resume Next ActiveSheet.ShowAllData ' Pour supprimer les autres filtres. ActiveSheet.ListObjects("Tableau_Action").Range.AutoFilter Field:=3, Criteria1:="=*x*" ' Pour filtrer sur la 3e colonne dans mon exemple. Application.EnableEvents = True End Sub
Citation:

Envoyé par Philippe Tulliez

il y a plus simple. Sans VBA et avec un segment

Effectivement, il faudra penser à faire une procédure pour que l'utilisateur respecte certaines consignes, comme l'interdiction de supprimer le segment.

Vos idées sur les formules m'ont fait réféchir

Voilà ce que j'ai corrigé dans mon tableau

J'ai inséré une nouvelle feuille avec un tableau contenant tous les jours non travaillés comme les vacances et les jours fériés

J'ai ajouté une colonne avec cette formule

Code:

=SI(SERIE.JOUR.OUVRE([@Intervention];0;TS_Feries_Vacances[Date])=SERIE.JOUR.OUVRE(AUJOURDHUI();-1;TS_Feries_Vacances[Date]);"Hier";SI([@Intervention]=AUJOURDHUI();"Aujourd'hui";SI(SERIE.JOUR.OUVRE([@Intervention];0;TS_Feries_Vacances[Date])=SERIE.JOUR.OUVRE(AUJOURDHUI();1;TS_Feries_Vacances[Date]);"Demain";"")))

et pour terminer, j'ai ajouté un segment ou les 3 macros ci-dessous
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 Sub Bouton_Filtrer_Hier() Application.ScreenUpdating = False Call Liberer_filtre_TS(Range("TS_Suivi")) ActiveSheet.ListObjects("TS_Suivi").Range.AutoFilter Field:=Range("TS_Suivi" & "[Hier Demain]").Column, Criteria1:="=Hier" ActiveWindow.ScrollRow = 1 'Jusqu'à la ligne Application.ScreenUpdating = True End Sub Sub Bouton_Filtrer_Aujourdhui() Application.ScreenUpdating = False Call Liberer_filtre_TS(Range("TS_Suivi")) ActiveSheet.ListObjects("TS_Suivi").Range.AutoFilter Field:=Range("TS_Suivi" & "[Hier Demain]").Column, Criteria1:="=Aujourd'hui" ActiveWindow.ScrollRow = 1 'Jusqu'à la ligne Application.ScreenUpdating = True End Sub Sub Bouton_Filtrer_Demain() Application.ScreenUpdating = False Call Liberer_filtre_TS(Range("TS_Suivi")) ActiveSheet.ListObjects("TS_Suivi").Range.AutoFilter Field:=Range("TS_Suivi" & "[Hier Demain]").Column, Criteria1:="=Demain" ActiveWindow.ScrollRow = 1 'Jusqu'à la ligne Application.ScreenUpdating = True End Sub

Voir 40 message(s) de cette discussion en une page