AutoFilter sur date & SpecialCells

jhofman · 28 Avril 2009

bonjour

je cherche à suppimer RAPIDEMENT (15000 lignes) des lignes d'une feuille dont la date est antérieure à une certaine valeur :

Code:

With Range(Range("B1"), Range("B65536").End(xlUp))
        .AutoFilter Field:=1, Criteria1:="<=" & Format(dt, "dd-mmm-yyyy"), Operator:=xlAnd
Range("_FilterDataBase").Offset(1, 0).Resize(Range("_FilterDataBase"). _
Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete

j'ai deux problèmes
- parfois le critère n'est pas appliqué - je ne sais pas acorder le format du critere avec le format de la colonne B
- comment gérer la seconde partie de la commande quand aucune ligne n'est à supprimer ?

jhofman · 28 Avril 2009

Re : AutoFilter sur date & SpecialCells

complément sur le premier point
le filtre est bien renseigné par la macro à l'écran (Filtre presonnalisé) mais n'est pas appliqué effectivement sur la feuille sauf si j'ouvre le filtre et le consulte de manière interractive et clique sur OK

STephane · 28 Avril 2009

Re : AutoFilter sur date & SpecialCells

bonjour,

cela semble fonctionner :

Code:

Sub djdjsfsdfdsd()
Dim Dt, rg2delete, Records_Found As Boolean
Dt = Now


With Range(Range("B1"), Range("B65536").End(xlUp))
        '.AutoFilter Field:=1, Criteria1:="<=" & Format(Dt, "dd-mmm-yyyy"), Operator:=xlAnd
        
        'essayer d'octroyer au critère le format de la 1° cellule de la base
        .AutoFilter Field:=1, Criteria1:="<=" & Format(Dt, .Item(1).NumberFormat), Operator:=xlAnd

        'détermination de la plage de la base filtrée sans son en-tête
        Set rg2delete = Range("_FilterDataBase").offset(1, 0).Resize(Range("_FilterDataBase").Rows.count - 1)
        
        'si le compte du nombre d'enregistrements trouvés > 0, alors la variable Records_Found=true
        Records_Found = (Application.WorksheetFunction.Subtotal(3, rg2delete.Columns(1)) > 0)
        If Records_Found Then rg2delete.EntireRow.Delete
        
        'enlever le filtre
        .AutoFilter
End With

End Sub

jhofman · 28 Avril 2009

Re : AutoFilter sur date & SpecialCells

merci

j'ai testé et apporté un eléère correction et tout est impécable

Code:

Sub filtrer()
Dim Dt, rg2delete, Records_Found As Boolean
Dt = Now()


With Range(Range("B1"), Range("B65536").End(xlUp))
        '.AutoFilter Field:=1, Criteria1:="<=" & Format(Dt, "dd-mmm-yyyy"), Operator:=xlAnd
        
        'essayer d'octroyer au critère le format de la 1° cellule de la base
        .AutoFilter Field:=1, Criteria1:="<=" & Format(Dt, .Item([COLOR="red"]2[/COLOR]).NumberFormat), Operator:=xlAnd

        'détermination de la plage de la base filtrée sans son en-tête
        Set rg2delete = Range("_FilterDataBase").Offset(1, 0).Resize(Range("_FilterDataBase").Rows.Count - 1)
        
        'si le compte du nombre d'enregistrements trouvés > 0, alors la variable Records_Found=true
        Records_Found = (Application.WorksheetFunction.Subtotal(3, [COLOR="Red"]rg2delete.Columns[/COLOR]) > 0)
        If Records_Found Then rg2delete.EntireRow.Delete
        
        'enlever le filtre
        .AutoFilter
End With

End Sub

AutoFilter sur date & SpecialCells

jhofman

XLDnaute Occasionnel

jhofman

XLDnaute Occasionnel

STephane

XLDnaute Occasionnel

jhofman

XLDnaute Occasionnel

Pièces jointes

Discussions similaires