XL 2016 Filtrer années

[KTM]

Bonjour Cher Forum
Je voudrais un code pour filtrer sur ma colonne B les dates qui correspondent a l’année indiquée en D1
Merci

 

[Staple1600]

Bonjour le fil, KTM

KTM
Tu as essayé d'appliquer un filtre automatique tout en laissant tourner l'enregistreur de macros.?
Si oui, tu obtiendras alors le code VBA que tu veux.

 

[patricktoulon]

Bonjour

Sub filtreannée()
 With ActiveSheet.Range("$B$3", Cells(Rows.Count, "B").End(xlUp))
   .AutoFilter Field:=1, Criteria2:=Array(0, "12/1/" & [d1].Value), Operator:=xlFilterValues
End With
End Sub

Affecte la macro "filtreannée" a ta ton bouton
et met ta D1 en format nombre

 

[Staple1600]

Bonjour aussi à toi patricktoulon...

J'avais fait dans le basique
(comme c'est fait je poste)
NB: Comme précédemment indiqué, code adapté du code fourni par l'enregistreur de macros.

Sub Filtre_ANNEE()
D_AN = CLng(CDate("1/1/" & [D1]))
F_AN = CLng(CDate("31/12/" & [D1]))
ActiveSheet.Range("$B$1:$B$678").AutoFilter Field:=1, Criteria1:=">=" & D_AN, Operator:=xlAnd, Criteria2:="<=" & F_AN
End Sub

PS: Adapter la plage des cellules selon le classeur avant de tester.

 

[KTM]

Bonjour

Sub filtreannée()
With ActiveSheet.Range("$B$3", Cells(Rows.Count, "B").End(xlUp))
   .AutoFilter Field:=1, Criteria2:=Array(0, "12/1/" & [d1].Value), Operator:=xlFilterValues
End With
End Sub

Affecte la macro "filtreannée" a ta ton bouton
et met ta D1 en format nombre

C'est juste.
Merci .

 

[Staple1600]

Décidément, Bonjour à toi aussi KTM...

Tu n'as pas vu le message#2?
Celui où je te posais une question...

 

[KTM]

Bonjour aussi à toi patricktoulon...

J'avais fait dans le basique
(comme c'est fait je poste)
NB: Comme précédemment indiqué, code adapté du code fourni par l'enregistreur de macros.

Sub Filtre_ANNEE()
D_AN = CLng(CDate("1/1/" & [D1]))
F_AN = CLng(CDate("31/12/" & [D1]))
ActiveSheet.Range("$B$1:$B$678").AutoFilter Field:=1, Criteria1:=">=" & D_AN, Operator:=xlAnd, Criteria2:="<=" & F_AN
End Sub

PS: Adapter la plage des cellules selon le classeur avant de tester.

Merci beaucoup

 

[patricktoulon]

bonjour Staple1600
la formulation array est plus simple non?

 

[Staple1600]

Re

•>patricktoulon
Oui.
Mais j'aime bien commencer ma journée sur XLD dans de bonnes conditions.
(C'est à dire courtoisement , d'où les première lignes des messages#4 et #6)

•>KTM
Merci pour le feedback
Mais toujours pas de réponse à ma question...
Parce que suite à la lecture du post de patricktoulon
(j'ai refait un test avec l'enregistreur de macros)
Ce qui donne

Sub Macro1()
Range("B3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.AutoFilter
ActiveSheet.Range("$B$3:$B$680").AutoFilter Field:=1, Operator:= _
xlFilterValues, Criteria2:=Array(0, "12/31/2018")
End Sub

Et on reconnait alors la presque même syntaxe (en rouge) que celle de patrick.
Ensuite à partir de ce code VBA obtenu par l'enregistreur, il ne restait plus qu'à adapter comme dans le code de patrick.
Tu comprends désormais mieux le pourquoi de la question du message#2

 

[Staple1600]

Re

On peut mettre directement le code dans la feuille concernée
(Comme cela, dès que la valeur change en D1, le filtre s'applique)

Private Sub Worksheet_Change(ByVal T As Range)
If T.Address = "$D$1" Then
Intersect(UsedRange.EntireRow, [B:B]).Offset(2).AutoFilter Field:=1, Operator:=7, Criteria2:=Array(0, "12/31/" & T)
Else
AutoFilterMode = False
End If
End Sub

NB: Reste à ajouter quelques contrôles
( D1 vide ou D1 avec du texte etc..)

EDITION: Bonjour job75

 

[patricktoulon]

re
oui moi aussi je fait deux critères en clng(date)quand les dates recherchées ne sont pas du même mois ou année
je ne sais pas si en remplaçant le "0" dans l'array par une date début ça fonctionnerait
il faudra que je teste

 

[job75]

Bonjour KTM, JM, patricktoulon,

Pour tester j'ai recopié le tableau sur 39 000 lignes.

La macro du post #10 s'effectue en 0,02 seconde chez moi, c'est immédiat.

Par curiosité j'ai testé :

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D1]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
On Error Resume Next 'si aucune SpecialCell
With [A2].CurrentRegion.Columns(2)
    .Rows.Hidden = False 'affiche tout
    If [D1] = "" Then Exit Sub
    .Replace [D1], "µ", xlPart
    .Rows.Hidden = True 'masque tout
    .SpecialCells(xlCellTypeConstants, 2).Rows.Hidden = False 'affiche les textes
    .Replace "µ", [D1]
End With
End Sub

Filtrage 2018 => 0,56 seconde, 2019 => 1,9 seconde, 2020 => 3,6 seconde.

A+

 

[job75]

Une solution plus acceptable avec ce fichier (2) :

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D1]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
On Error Resume Next 'si aucune SpecialCell
With [A2].CurrentRegion.Columns(4)
    .Rows.Hidden = False 'affiche tout
    If [D1] = "" Then Exit Sub
    .Formula = "=IF(ISNUMBER(B2),IF(YEAR(B2)<>D$1,1))"
    .SpecialCells(xlCellTypeFormulas, 1).Rows.Hidden = True 'masque les nombres
    .Value = ""
End With
End Sub

Sur 39 000 lignes, filtrage 2018 => 0,29 seconde, 2019 => 0,60 seconde, 2020 => 0,43 seconde.

 

[KTM]

Merci à tous
je suis Énormément comblé.