suppression lignes avec plusieurs crtitères

[thierry440]

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.

 

[Theze]

Bonjkour,

A tester :

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]

Merci cela est ok

à faire demain sur 420 000 enregistrements.

 

[Staple1600]

Bonsoir le fil, le forum

@thierry440
Pourquoi avoir ouvert un second fil?
https://www.excel-downloads.com/threads/macro-qui-supprime-les-lignes-suivant-conditions.20022663/
De plus pas de commentaires, sur les deux macros que je t'ai proposée.
Ce qui n'est pas la manière la plus sympathique d'encourager les répondeurs à t'aider, non ? 😉
(Sans parler du temps passé sur ton classeur...)

 

[thierry440]

Bonjour
Fonctionne avec un petit nombre de lignes , mais ne fonctionne pas avec 420 000 lignes.

Cordialement.

 

[Theze]

Bonjour,

Déclare la variable I en Long et non Integer si le nombre de lignes dépasse 32767 !

 

[thierry440]

C'est ok merci

 

[Staple1600]

Re

@thierry440
Et mon code VBA:
Avec un grand nombre de lignes, il fonctionne ou pas?
Voir message#4 de ce fil

 

[thierry440]

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