VBA suppression à plusieurs condition
Bonsoir tout le monde,
j'ai une VBA qui effectue le travail demander mais pour un " grand " tableau de donnée il bug et le temps d’exécution dépasse la normale.
Je pense avoir trouver le problème mais tout d'abord je vous explique ce que la macro fait :
sur une feuille 1 : il y a un tableau de chiffre ( chaque lignes à 5 colonnes )
sur une feuille 2 : il y a les consignes, des suites de chiffre à 3 colonnes et s'il apparaisse dans la feuille 1 alors il supprime la ligne de la feuille 1
le problème viendrais du fait que certaine lignes de la feuille 1 ne contienne pas les suites de chiffre de la feuille 2, au lieu de passer directement à la prochaine ligne de la feuille 1 il bug et met du temps à passer la ligne suivante.
Si quelqu'un aurait une idée de ce que je pourrais rajouter à la macro pour facilité le passage merci !
Voici ma macro :
Code:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
| Dim i As Integer, j As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayStatusBar = False
Application.EnableEvents = 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
Application.Calculation = xlCalculationManual
Application.DisplayStatusBar = True
Application.EnableEvents = True
End Sub |
Bonne journée à tous !