Supprimer sous condititon

bonjour,

j'ai trouver une vba sur ce forum qui permet de supprimer tout les lignes d'une feuille 1 s'il apparaît les 3 chiffres des 3 colonnes d'une feuille 2 dans les colonne allant de A à E d'une feuille 1.

elle fonctionne mais à un problème de rapidité qui vient surement du fait que dès qu'il na rien à supprimer il bug pendant assez longtemps si quelque aurait une idée de quoi ajouter s'il vous plait ?

voici la macro :

et dessous mon document

Dim i As Integer

Dim j As Long

Application.ScreenUpdating = False

With Sheets("Feuil2")

For i = 1 To .Range("A" & Rows.Count).End(xlUp).Row

For j = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1

If WorksheetFunction.CountIf(Range("A" & j & ":E" & j), .Range("A" & i)) > 0 And WorksheetFunction.CountIf(Range("A" & j & ":E" & j), .Range("B" & i)) > 0 And WorksheetFunction.CountIf(Range("A" & j & ":E" & j), .Range("C" & i)) > 0 Then

Rows(j).EntireRow.Delete

End If

Next j

Next i

End With

Application.ScreenUpdating = True

End Sub

On peut probablement ajouter un "exit For" pour limiter les boucles quand il trouve une correspondance mais au final ça fait potentiellement 3000 lignes (feuil2) par 15000 lignes (feuil1) soit 45 000 000 de tour de boucle donc pas très étonnant que ça prenne du temps.

Dim i As Integer
Dim j As Long

Application.ScreenUpdating = False

With Sheets("Feuil2")

For i = 1 To .Range("A" & Rows.Count).End(xlUp).Row
For j = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
If WorksheetFunction.CountIf(Range("A" & j & ":E" & j), .Range("A" & i)) > 0 And WorksheetFunction.CountIf(Range("A" & j & ":E" & j), .Range("B" & i)) > 0 And WorksheetFunction.CountIf(Range("A" & j & ":E" & j), .Range("C" & i)) > 0 Then
Rows(j).EntireRow.Delete
Exit For
End If
Next j
Next i

End With
Application.ScreenUpdating = True
End Sub

le exit for fait que je dois relancer la macro a chaque ligne, je pensais que c'était la macro le problème mais si c'est le nombre de lignes je n'ai pas le choix d'attendre :s merci quand même

Ah oui pardon, il faut inverser ton for i et for j pour que ça ne s’arrête pas

Dim i As Integer
Dim j As Long

Application.ScreenUpdating = False

With Sheets("Feuil2")
For j = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
For i = 1 To .Range("A" & Rows.Count).End(xlUp).Row
If WorksheetFunction.CountIf(Range("A" & j & ":E" & j), .Range("A" & i)) > 0 And WorksheetFunction.CountIf(Range("A" & j & ":E" & j), .Range("B" & i)) > 0 And WorksheetFunction.CountIf(Range("A" & j & ":E" & j), .Range("C" & i)) > 0 Then
Rows(j).EntireRow.Delete
Exit For
End If
Next i
Next j

End With
Application.ScreenUpdating = True
End Sub

cela est encore trop long :s

sinon j'ai penser a une autre chose peut être plus efficace,

si condition valider alors ne rien faire mais Si condition Non valider alors copier dans feuille 3.

comme sa au lieu de supprimer 80 000 lignes il en copiera 15 000 environ dans une feuille ?