Filtre VBA

Bonjour,

J'ai besoin de vos lumières concernant les filtres chronologiques.

J'ai un tableau avec deux colonnes A et B. Dans la colonne A, j'ai plusieurs dates allant de 2016 à 2019. Le but est de cocher les cases dans la colonne B par "X" dont les dates sont inférieures de 2 semaines uniquement par rapport à la date actuelle et finalement dé filtrer pour voir toutes les données avec les cases cochées "X" et celles qui ne sont pas.

Le problème est que j'ai une date en 2019 dans la colonne A en première ligne et quand le traitement de la macro est terminé, je ne trouve pas les cases cochées.

Voici le code:

Sub Macro()

ActiveSheet.ListObjects("Tableau1").Range.AutoFilter Field:=1, Criteria1:= _

"<15/08/2019", Operator:=xlAnd

Range("F5").Select

ActiveCell.FormulaR1C1 = "X"

Selection.FillDown

ActiveSheet.ListObjects("Tableau1").Range.AutoFilter Field:=1

End Sub

Bonjour,

Un exemple à adapter.

Cdlt.

Public Sub FilterData()
Dim ws As Worksheet, lo As ListObject, dt As Date, Rng As Range, Cell As Range
    Application.ScreenUpdating = False
    Set ws = ActiveSheet
    Set lo = ws.ListObjects(1)
    dt = Date - 14
    With lo
        'If .ShowAutoFilter Then .AutoFilter.ShowAllData
        .Range.AutoFilter Field:=1, Criteria1:="<" & CLng(dt)
        On Error Resume Next
        Set Rng = .ListColumns(2).DataBodyRange.SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        If Not Rng Is Nothing Then
            For Each Cell In Rng
                Cell.Value = "X"
            Next Cell
        End If
        .Range.AutoFilter Field:=1
    End With
End Sub

Bonjour Sequence, Jean-Eric,

une version sans la boucle,

Public Sub FilterData()
Dim ws As Worksheet, lo As ListObject, dt As Date, Rng As Range, Cell As Range
    Application.ScreenUpdating = False
    Set ws = ActiveSheet
    Set lo = ws.ListObjects(1)
    dt = Date - 14
    With lo
        'If .ShowAutoFilter Then .AutoFilter.ShowAllData
        .Range.AutoFilter Field:=1, Criteria1:="<" & CLng(dt)
        On Error Resume Next
        .ListColumns(2).DataBodyRange.SpecialCells(xlCellTypeVisible) = "x"
        .Range.AutoFilter Field:=1
    End With
End Sub

Merci chers passionés, cela fonctionne parfaitement.

J'ai une autre question, parmi toutes les années de la colonne A, comment je peux sélectionner les 2 prochains mois de l'année uniquement suivant la date du jour?

re,

à tester,

dt1 = DateSerial(Year(Now), Month(Now) + 1, 1)
dt2 = DateSerial(Year(Now), Month(Now) + 2, 1)
lo.Range.AutoFilter Field:=1, Criteria1:=">=" & dt1, Operator:=xlAnd, Criteria2:="<=" & dt2

Bonjour,

Puisque que nous sommes en France.

A tester.

Cdlt.

lo.Range.AutoFilter _
            Field:=1, _
            Criteria1:=">=" & CLng(dt1), _
            Operator:=xlAnd, _
            Criteria2:="<=" & CLng(dt2)

Bonjour,

J'ai testé vos codes mais cela ne fonctionne pas de mon côté. J'ai ajouté une colonne C pour travailler le code dessus.

En effet, ma demande est de prendre, à partir de la date d'aujourd'hui, toutes les dates venant après, y compris celles des 2 mois suivant de l'année en cours.

Bon, j'ai trouvé la solution pour ceux et celles à qui ça intéresse:

Sub FilterData()

Dim ws As Worksheet, lo As ListObject, dt As Date, Rng As Range, Cell As Range, dt0 As Date, dt1 As Date

Application.ScreenUpdating = False

Set ws = ActiveSheet

Set lo = ws.ListObjects(1)

dt = Date - 14

dt0 = DateSerial(Year(Now), Month(Now), Day(Now))

dt1 = DateSerial(Year(Now), Month(Now) + 2, 1)

With lo

'If .ShowAutoFilter Then .AutoFilter.ShowAllData

.Range.AutoFilter field:=1, Criteria1:="<" & CLng(dt)

On Error Resume Next

.ListColumns(2).DataBodyRange.SpecialCells(xlCellTypeVisible) = "X"

.Range.AutoFilter field:=1

End With

With lo

.Range.AutoFilter field:=1, Criteria1:=">=" & CLng(dt0), Operator:=xlAnd, Criteria2:="<=" & CLng(dt1)

On Error Resume Next

.ListColumns(3).DataBodyRange.SpecialCells(xlCellTypeVisible) = "X"

.Range.AutoFilter field:=1

End With

End Sub

Merci chers passionés pour votre support et bonne journée!