Supprimer les lignes lorsqu'une condition est appliquée à une colonne.

[josanche]

Bonjour à tous

j'aurais besoin de votre aide. Dans mon fichier en piece jointe, j'ai dans la feuille 1 tout plein de ligne dont la colonne A reprend différents noms qui peuvent se répéter plusieurs fois. et dans la feuille 2, j'ai une liste de noms. Je voudrais que les lignes qui porte dans leur colonne A un des noms de la liste de noms en feuille 2 soient supprimé.

J'ai trouvé ceci sur un autre forum mais j'ai essayé de réajuster mais ca semble pas marcher.


Sub Supprimer()
Application.ScreenUpdating = False
With Feuil1
For lg = .Range("A4").End(xlDown).Row To 4 Step -1
Set Trouve = Feuil3.Range("A:A").Find(Cells(lg, 3), LookIn:=xlValues, lookat:=xlWhole)
If Trouve Is Nothing Then Rows(lg).EntireRow.Delete
Next
End With
Application.ScreenUpdating = True
End Sub

Pouvez-vous m'aider à corriger 🙂 ?

Veuillez cliquer sur le lien pour uploader mon fichier http://db.tt/fyiLxk90

Merci d'avance pour votre aide

 

[phlaurent55]

Re : Supprimer les lignes lorsqu'une condition est appliquée à une colonne.

Bonjour Josange,

avec ceci:

Sub Supprimer()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Sheets(1).Select
derligne = Sheets(2).Range("A65535").End(xlUp).Row
For i = 3 To derligne
For j = Sheets(1).Range("A65535").End(xlUp).Row To 4 Step -1
If Cells(j, 1) = Sheets(2).Cells(i, 1) Then Rows(j).EntireRow.Delete
Next j
Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

à+
Philippe

Edit: Vu le nombre de lignes, la procédure dure quelques secondes

 

[pierrejean]

Re : Supprimer les lignes lorsqu'une condition est appliquée à une colonne.

Bonjour josanche

A tester:

Sub supprimer()
Application.ScreenUpdating = False
tablo = Sheets("Feuil2").Range("A3:A" & Sheets("Feuil2").Range("A" & Rows.Count).End(xlUp).Row)
For n = Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
 For m = LBound(tablo, 1) To UBound(tablo, 1)
   If Sheets("Feuil1").Range("A" & n) = tablo(m, 1) Then
     Sheets("Feuil1").Rows(n).Delete
   End If
 Next m
Next n
Application.ScreenUpdating = True
End Sub

Edit: Salut Phillipe