Suppression lignes sous condition

Résolu/Fermé
a51432 Messages postés 37 Date d'inscription lundi 13 juillet 2015 Statut Membre Dernière intervention 20 octobre 2015 - 19 août 2015 à 11:59
a51432 Messages postés 37 Date d'inscription lundi 13 juillet 2015 Statut Membre Dernière intervention 20 octobre 2015 - 20 août 2015 à 17:47
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,

2 réponses

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 310
19 août 2015 à 15:53
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 ?
0
a51432 Messages postés 37 Date d'inscription lundi 13 juillet 2015 Statut Membre Dernière intervention 20 octobre 2015 1
20 août 2015 à 17:47
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
0