suppression lignes avec plusieurs crtitères

thierry440

XLDnaute Junior
Bonjour

J'essaye d'optimiser échantillon 200 lignes ( 420000) dans fichier source.
le but étant de supprimer les lignes remplissant condition :
colonne 4 : Clôturé
colonne 26 : < 2016

merci d'avance.
 

Fichiers joints

Theze

XLDnaute Occasionnel
Bonjkour,

A tester :
Code:
Sub Efface()
    'supprime les enregistrements condition colonne D et Z
   
    Dim i As Integer
   
    For i = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
   
        If Cells(i, 4).Value = "Clôturé" And Cells(i, 26).Value < 2016 Then
            Cells(i, 4).EntireRow.Delete
        End If
   
    Next i
   
End Sub
 

thierry440

XLDnaute Junior
Test fait sur 420 000 lignes plante erreur 1004 sur ligne ActiveSheet.ShowAllData: Range("AB1:AB2") = ""

Macro test :

Sub test_OK()

Dim pf As Range

With [A1].CurrentRegion

.Item(2, 28).FormulaR1C1 = "=(RC4=""cloturé"")+(YEAR((""1/1/""&RC26)*1)<2016)=2"

.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("AB1:AB2"), Unique:=False

End With

Set pf = [_FilterDataBase]

Application.DisplayAlerts = False

If WorksheetFunction.Subtotal(3, pf.Offset(1).Resize(pf.Rows.Count - 1, 1)) > 0 Then

pf.Offset(1).Resize(pf.Rows.Count - 1).EntireRow.Delete

End If
 

Discussions similaires


Haut Bas