suppression lignes avec plusieurs crtitères

T

Theze

XLDnaute Occasionnel

• 15 Février 2018

• #2

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

 

Vote positif 0 Vote négatif

T

thierry440

Guest

• 15 Février 2018

• #3

Merci cela est ok

à faire demain sur 420 000 enregistrements.

 

Vote positif 0 Vote négatif

Staple1600

XLDnaute Barbatruc

• 15 Février 2018

• #4

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...)

 

Vote positif 0 Vote négatif

T

thierry440

Guest

• 16 Février 2018

• #5

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

Cordialement.

 

Vote positif 0 Vote négatif

T

Theze

XLDnaute Occasionnel

• 17 Février 2018

• #6

Bonjour,

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

 

Vote positif 0 Vote négatif

T

thierry440

Guest

• 17 Février 2018

• #7

C'est ok merci

 

Vote positif 0 Vote négatif

Staple1600

XLDnaute Barbatruc

• 17 Février 2018

• #8

Re

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

 

Vote positif 0 Vote négatif

T

thierry440

Guest

• 21 Février 2018

• #9

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

 

Vote positif 0 Vote négatif