Suppression lignes sous condition
Résolu
a51432
Messages postés
39
Statut
Membre
-
a51432 Messages postés 39 Statut Membre -
a51432 Messages postés 39 Statut Membre -
Bonjour,
Je dispose d'un fichier avec une colonne contenant des noms de clients. Je souhaite tester chacune des cellules de cette colonne et supprimer la ligne entière si le nom contenu dans la cellule et différent de chacun des noms contenus dans un tableau (une cinquantaine de noms est contenue dans ce tableau).
Si quelqu'un a une solution que je puisse adapter..
Merci de votre aide
Cordialement,
Je dispose d'un fichier avec une colonne contenant des noms de clients. Je souhaite tester chacune des cellules de cette colonne et supprimer la ligne entière si le nom contenu dans la cellule et différent de chacun des noms contenus dans un tableau (une cinquantaine de noms est contenue dans ce tableau).
Si quelqu'un a une solution que je puisse adapter..
Merci de votre aide
Cordialement,
2 réponses
-
Bonjour
si le nom contenu dans la cellule et différent de chacun des noms contenus dans un tableau
je dois mal comprendre:
si tous les noms sont différents, la colonne est vide ? -
Merci de ta réponse, je n'ai en effet pas été très précis mais c'était assez compliqué à expliquer. Et le but était de supprimer la ligne si le nom dans la cellule était différent de tous les noms contenus dans mon Array.
J'ai finalement trouvé la solution :
Sub Macro()
Application.ScreenUpdating = False
Dim h, k As Integer
Dim Clt()
Dim derLig As Long
Dim stFile As String
stFile = "clients.xlsx"
Clt = Array("NOM1*", "NOM2*", "NOM3*")
With Workbooks(stFile).Sheets(Feuille)
derLig = .Range("A" & .Rows.Count).End(xlUp).Row
.Columns("G:G").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
For h = derLig To 3 Step -1
For k = LBound(Clt) To UBound(Clt)
If .Cells(h, 6) Like Clt(k) Then
.Cells(h, 7) = 1
Exit For
Else
.Cells(h, 7) = 0
End If
Next k
If .Cells(h, 7) = 0 Then
.Cells(h, 1).EntireRow.Delete
End If
Next h
.Columns("G:G").EntireColumn.Delete
End With
Application.ScreenUpdating = True
End Sub
