Re Bonjour à Tous
voici le code documenté et perfectionné pour des tableaux pouvant commencer à n'importe quelle ligne. Je l'ai mis également en pièce jointe, c'est plus simple avec les tabulations.
Cordialement, A+ Yeah!
Sub Supprimer_Lignes()
'définition des variables
Dim Tab_Cells As Variant, Tab_Row() As String, Mem_Row As Long
Dim Cellule_Debut As Range, Cellule_Fin
Dim Deb_Tab As Long, Compteur As Long, Compteur2 As Long, Compteur3 As Long
'désactivation de l'affichage écran pour gagner en rapidité
Application.ScreenUpdating = False
With ActiveSheet
'indiquer ici la plage de test
'si je désire tester les cellules colonnes A et D sur 6000 lignes la plage sera range("A1
6000")
'la ligne suivante définit le début du tableau de valeurs pour test
Set Cellule_Debut = .Range("A1")
'la ligne suivante définit la fin du tableau de valeurs pour test
'la valeur actuelle correspond à la dernière cellule de la colonne D avec possibilité de valeur
Set Cellule_Fin = Range("D" & Range("A1").SpecialCells(xlCellTypeLastCell).Row)
'mémorise la ligne de début du tableau de valeurs
Mem_Row = Cellule_Debut.Row - 1
'passe les valeurs de cellules au tableau de valeurs
Tab_Cells = .Range(Cellule_Debut.Address & ":" & Cellule_Fin.Address).Value
'initialise les compteurs
Compteur = 0
Compteur3 = 65536
'boucle sur la longueur du tableau
For Compteur2 = LBound(Tab_Cells) To UBound(Tab_Cells)
'indiquer ici la valeur du test et les ou la colonne du tableau, ici 2 car colonnes de test sur A et D
If Tab_Cells(Compteur2, 1) = "PCI Dump" Or Tab_Cells(Compteur2, 4) = "519" Then
If Compteur3 < 65536 Then
'indiquer ici les colonnes à supprimer, laisser de A à IV pour lignes entières
Tab_Row(Compteur) = "A" & (Compteur3 + Mem_Row) & ":" & "IV" & (Compteur2 + Mem_Row)
Else
'si première ligne en test ok ou ligne d'avant en test no ok, on incrémentre compteur
Compteur = Compteur + 1
'on redimensionne en conservant les valeurs
ReDim Preserve Tab_Row(1 To Compteur) As String
'indiquer ici la plage à supprimer, laisser de A à IV pour lignes entières
Tab_Row(Compteur) = "A" & (Compteur2 + Mem_Row) & ":" & "IV" & (Compteur2 + Mem_Row)
'on enregistre le numéro de première ligne test ok
Compteur3 = Compteur2
End If
Else
Compteur3 = 65536
End If
Next Compteur2
'on efface les lignes détectées en partant de la fin
For Compteur2 = Compteur To 1 Step -1
'pour test
'Application.ScreenUpdating = True
'.Range(Tab_Row(Compteur2)).Select
'MsgBox Tab_Row(Compteur2)
.Range(Tab_Row(Compteur2)).Delete Shift:=xlUp
Next Compteur2
.Range("A1").Select
End With
MsgBox "fini"
End Sub