Macro VBA pour supprimer une ligne entière

Version imprimable

1 pièce(s) jointe(s)

Bonjour,

Je suis nouveau sur ce forum, d'ailleurs je vous en félicite

J'expose ici une problématique que je rencontre depuis quelques temps maintenant et que je n'arrive pas à résoudre, en effet, je dispose d'une fichier de prospection qui contient, 5 colonnes à savoir Nom, Adresse, Code Postal, Ville et Numéro de Tél avec plus de 63000 contacts dedans.

Pour des raisons longues à expliquer, j'ai besoin de filtrer la colonne A (Nom) ceci dis que le filtre permettra de supprimer toutes les LIGNES contenant des mots signalé au préalable.

Ci dessous la macro que j'ai créer et qui malheureusement ne fonctionne pas !

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Option Explicit
Option Compare Text
 
Sub traiter()
    Dim i&, fin&, a
    With Feuil1 ' à adapter si ta feuille à traiter s'appelle autrement
   fin = .Range("A" & Rows.Count).End(xlUp).Row
        For i = fin To 2 Step -1
            For Each a In Array("(", ")", "&", "+", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "mairie", "départ", "municipa", "direct", "biblio", "gymnas", "famill", "fédération", "police", "gendarmerie", "association", "aide", "boucherie", "cinéma", "communaut", "commu", "cercle", "animation", "bureau", "club", "hô", "région", "centre", "comit", "complexe", "conseil", "menui", "HLM", "Union", "CFDT", "collectif", "Clinique", "cabinet", "docteur", "groupement", "atelier", "décheterie", "amicale", "franch", "football", "etabli", "pompier", "café", "restaurant", "agent", "ecole", "foyer", "publ", "autom", "studio", "entr", "ets", "meub", "cantine", "lycée", "univ", "publi", "entreprise", "Aumônerie", "etablissement", "assistance", "assur", "sport", "gare", "banque", "poste", "piscine", "salle", "service", "société", "soc", "agence", "immob", "santé", "travaux", "garderie", "crèche", "ferme", "centrale","caisse", "eurl", "gaec", "bijouterie", "gestion", "comptoi", "garage", "adhérant", "adhérent", "chômage", "france", "belg", "interna", "telecom", "cabine", "info", "auto", "moto", "concess", "agt", "securit", "jeux", "auchan", "casino", "carrefour", "geant", "magasin", "march", "fleuriste", "radio", "camping", "eglise", "route", "transport", "ambulance", "sud", "taxi", "pompe", "française", "concierg", "rouge", "earl", "sarl", "groupe", "academie", "accor", "diffusion", "distributeur", "aéro", "distr", "canton", "chambre", "syndic", "parti", "coif", "commerce", "comm", "Déchetterie", "intercomm", "local", "point", "pharm", "auberge", "scea", "social", "edf", "gdf", "espace", "agri", "labo", "coop", "cultur", "scol", "cave", "maison", "agro", "emploi", "indust", "cyber", "group", "pizza", "imprim", "profess", "mutuell", "format", "insti", "Allo", "refuge", "avenir", "national", "compagnie", "office", "tourism", "médic", "vacanc", "village", "sncf", "distrib", "station", "coop", "musé", "musiq", "parc", "zoo", "abat", "vété", "inspec", "ADMR", "action", "")
                If .Cells(i, 1) = a Then Rows(i).Delete shift:=xlUp: Exit For
            Next a
        Next i
    End With
End Sub

Vous trouvez également en pièce jointe le fichier texte pour les mots que je veux supprimer, je n'ai pas pu uploader le fichier excel vu sa taille :?

Dans l'attente de vous lire.

19/12/2016, 05h10
Invité

Bonjour,

Regardez l'utilisation de la méthode Find dans l'aide en ligne VBA Excel ou sur ce forum.

Cordialement.
19/12/2016, 09h06
Menhir

Citation:

Envoyé par Riahi's

Pour des raisons longues à expliquer, j'ai besoin de filtrer la colonne A (Nom) ceci dis que le filtre permettra de supprimer toutes les LIGNES contenant des mots signalé au préalable.

Ci dessous la macro que j'ai créer et qui malheureusement ne fonctionne pas !

"Ca ne fonctionne pas", c'est un peu court comme explication de ce qui dysfonctionne.

Je pense que ton problème vient d'une confusion entre "contenant" (ce que tu souhaites d'après tes explications) et "égal à" (ce qui est écrit dans ton code).

Essaye de remplacer ta ligne If par :

Code:

If InStr(.Cells(i, 1), a) > 0 Then Rows(i).Delete shift:=xlUp: Exit For
19/12/2016, 12h12
Marc-L

Bonjour,

cela pourrait s'avérer plus rapide via un filtre avancé avec un critère calculé
ou encore juste une formule de calculs marquant les lignes à supprimer puis l'effacement après un tri …

_________________________________________________________________________________________________________
Je suis Paris, Nice, Bruxelles, Charlie, …
21/12/2016, 19h38
Riahi's

1 pièce(s) jointe(s)

Citation:

Envoyé par Menhir

"Ca ne fonctionne pas", c'est un peu court comme explication de ce qui dysfonctionne.

Je pense que ton problème vient d'une confusion entre "contenant" (ce que tu souhaites d'après tes explications) et "égal à" (ce qui est écrit dans ton code).

Essaye de remplacer ta ligne If par :

Code:

If InStr(.Cells(i, 1), a) > 0 Then Rows(i).Delete shift:=xlUp: Exit For

Bonjour, et désolé pour ma réponse assez tardive.

Je vous joint un screenshot de mon code VBA, en effet, la problématique viens essentiellement des mots clés déclarés, comme vous pouvez le voir dans le screenshot, après en faisant un RUN de la macro j'ai une erreur (Erreur de compilation : erreur de syntaxe)
Pièce jointe 229837
J'ai pris en considération ton point de vue et j'ai changé la ligne IF...
21/12/2016, 19h51
unparia

Bonjour
Le code présenté l'ayant été sous forme de capture d'écran et non de code mis entre balises code, il est difficile de voir son écriture réelle dans ton projet.
Et celui présenté sous forme de citation dans ton tout premier message non plus ...:cry:

Excusez moi, effectivement c'est une bourde que j'ai comise.

Ci dessous le code entier

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
Option Explicit
Option Compare Text
 
Sub traiter()
Dim i&, fin&, a
With Feuil1 ' à adapter si ta feuille à traiter s'appelle autrement
fin = .Range("A" & Rows.Count).End(xlUp).Row
For i = fin To 2 Step -1
For Each a In Array("(", ")", "&", "+", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "mairie", "départ", "municipa", "direct", "biblio", "gymnas", "famill", "fédération", "police", "gendarmerie", "association", "aide", "boucherie", "cinéma", "communaut", "commu", "cercle", "animation", "bureau", "club", "hô", "région", "centre", "comit", "complexe", "conseil", "menui", "HLM", "Union", "CFDT", "collectif", "Clinique", "cabinet", "docteur", "groupement", "atelier", "décheterie", "amicale", "franch", "football", "etabli", "pompier", "café", "restaurant", "agent", "ecole", "foyer", "publ", "autom", "studio", "entr", "ets", "meub", "cantine", "lycée", "univ", "publi", "entreprise", "Aumônerie", "etablissement", "assistance", "assur", "sport", "gare", "banque", "poste", "piscine", "salle", "service", "société", "soc", "agence", "immob", "santé", "travaux", "garderie", "crèche", "ferme", "centrale","caisse", "eurl", "gaec", "bijouterie", "gestion", "comptoi", "garage", "adhérant", "adhérent", "chômage", "franc
e", "belg", "interna", "telecom", "cabine", "info", "auto", "moto", "concess", "agt", "securit", "jeux", "auchan", "casino", "carrefour", "geant", "magasin", "march", "fleuriste", "radio", "camping", "eglise", "route", "transport", "ambulance", "sud", "taxi", "pompe", "française", "concierg", "rouge", "earl", "sarl", "groupe", "academie", "accor", "diffusion", "distributeur", "aéro", "distr", "canton", "chambre", "syndic", "parti", "coif", "commerce", "comm", "Déchetterie", "intercomm", "local", "point", "pharm", "auberge", "scea", "social", "edf", "gdf", "espace", "agri", "labo", "coop", "cultur", "scol", "cave", "maison", "agro", "emploi", "indust", "cyber", "group", "pizza", "imprim", "profess", "mutuell", "format", "insti", "Allo", "refuge", "avenir", "national", "compagnie", "office", "tourism", "médic", "vacanc", "village", "sncf", "distrib", "station", "coop", "musé", "musiq", "parc", "zoo", "abat", "vété", "inspec", "ADMR", "action", "")
If InStr(.Cells(i, 1), a) > 0 Then Rows(i).Delete shift:=xlUp: Exit For
Next a
Next i
End With
End Sub

21/12/2016, 20h09
unparia
Déjà (et bien que cela n'explique pas tout)
Le dernier élément de ton array est "". Ce qui fait que quel que puisse être le contenu (si non vide) analysé, instr est toujours > 0 (= 1 si les autres éléments de l'array ne sont pas là).
Preuve
Code:

1 2 3 toto = "abracadabra" MsgBox InStr(toto, "")
et ne retournera 0 qui si le contenu est vide
Tuy vois la faille de raisonnement, là, déjà ? J'espère que oui.

Bonsoir,

Ce que vous dites est logique, ceci dit je suis loin d'être un pro de la programmation et du VBA, je suis également loin de comprendre les syntaxes des chaines de codes, d'ailleurs j'ai pu corriger une partie du code et ça a marché quand j'ai minimiser le nombre de mots clés que je veux supprimer, je cite :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 
Option Explicit
Option Compare Text
 
Sub traiter()
Dim i&, fin&, a
With Feuil1
fin = .Range("A" & Rows.Count).End(xlUp).Row
For i = fin To 2 Step -1
For Each a In Array("(", ")", "&", "+", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "mairie", "départ", "municipa", "direct", "biblio", "gymnas", "famill", "fédération", "police", "gendarmerie", "association", "aide", "boucherie", "cinéma", "communaut", "commu", "cercle", "animation", "bureau", "club", "hô", "région", "centre", "comit", "complexe", "conseil", "menui", "HLM", "Union", "CFDT", "collectif", "Clinique", "cabinet", "docteur", "groupement", "atelier", "décheterie", "amicale", "franch", "football", "etabli", "pompier", "café", "restaurant", "agent", "ecole", "foyer", "publ", "autom", "studio", "entr", "ets", "meub", "cantine", "lycée", "univ", "publi", "entreprise", "Aumônerie", "etablissement", "assistance", "assur", "sport", "gare", "banque", "poste", "piscine", "salle", "service", "société", "soc", "agence", "immob", "santé", "travaux", "garderie", "crèche", "ferme", "centrale", "caisse", "eurl", "gaec", "bijouterie", "gestion", "comptoi", "garage", "adhérant", "adhérent")
If InStr(.Cells(i, 1), a) > 0 Then Rows(i).Delete shift:=xlUp: Exit For
Next a
Next i
End With
End Sub

Ceci dit que cela viens peut être du nombre assez conséquent de termes que je veux supprimer...
J'espère que vous puissiez m'aider.

Citation:

Envoyé par Riahi's

Bonjour,

En supposant que votre fichier contienne la liste des exclusions, le code suivant fonctionne.

Dans ce code, j'efface les lignes à exclure et je trie. La liste des exclusions est contenue dans la zone nommée "ListeAExclure" située dans un onglet Paramètres.

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
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
 
Option Explicit
Option Compare Text
 
Sub EffacerEtTrier_ModifieEK()
 
Dim CelluleExclusion As Range
Dim AireExclusions As Range
 
Dim CelluleDonnees As Range
Dim AireDonnees As Range
Dim TitreDonnees As Long
Dim DerniereLigneDonnees As Long
Dim DerniereColonneDonnees As Long
 
    Application.ScreenUpdating = False
 
    Set AireExclusions = Sheets("Paramètres").Range("ListeAExclure")
 
    With Sheets("Feuil1")
         TitreDonnees = 10
         DerniereLigneDonnees = .Cells(.Rows.Count, 1).End(xlUp).Row
         DerniereColonneDonnees = .Cells(TitreDonnees, .Columns.Count).End(xlToLeft).Column
         Set AireDonnees = .Range(.Cells(TitreDonnees + 1, 1), .Cells(DerniereLigneDonnees, 1))
 
        For Each CelluleDonnees In AireDonnees
            For Each CelluleExclusion In AireExclusions
                If InStr(CelluleDonnees, CelluleExclusion) > 0 Then CelluleDonnees.EntireRow.ClearContents
            Next CelluleExclusion
        Next CelluleDonnees
 
        Set AireDonnees = .Range(.Cells(TitreDonnees, 1), .Cells(DerniereLigneDonnees, DerniereColonneDonnees))
 
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=AireDonnees.Columns(1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .SetRange AireDonnees
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
 
    End With
 
    Set AireDonnees = Nothing
    Set AireExclusions = Nothing
 
    Application.ScreenUpdating = True
 
    MsgBox "Fin de traitement !", vbInformation, "Suppression des exclusions"
 
End Sub

Cordialement.

22/12/2016, 11h34
Marc-L

Bonjour Eric !

Assez proche de mon idée :

Citation:

Envoyé par Marc-L

cela pourrait s'avérer plus rapide via […]
ou encore juste une formule de calculs marquant les lignes à supprimer puis l'effacement après un tri …

En utilisant en VBA une formule de calculs, tu éviterais la double boucle des lignes 26 à 30
et tu pourrais après un tri effacer la globalité en une seule instruction …

Et la liste d'exclusion pourrait être ouverte directement à partir du fichier texte …

Citation:

Envoyé par Eric KERGRESSE

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
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
 
Option Explicit
Option Compare Text
 
Sub EffacerEtTrier_ModifieEK()
 
Dim CelluleExclusion As Range
Dim AireExclusions As Range
 
Dim CelluleDonnees As Range
Dim AireDonnees As Range
Dim TitreDonnees As Long
Dim DerniereLigneDonnees As Long
Dim DerniereColonneDonnees As Long
 
    Application.ScreenUpdating = False
 
    Set AireExclusions = Sheets("Paramètres").Range("ListeAExclure")
 
    With Sheets("Feuil1")
         TitreDonnees = 10
         DerniereLigneDonnees = .Cells(.Rows.Count, 1).End(xlUp).Row
         DerniereColonneDonnees = .Cells(TitreDonnees, .Columns.Count).End(xlToLeft).Column
         Set AireDonnees = .Range(.Cells(TitreDonnees + 1, 1), .Cells(DerniereLigneDonnees, 1))
 
        For Each CelluleDonnees In AireDonnees
            For Each CelluleExclusion In AireExclusions
                If InStr(CelluleDonnees, CelluleExclusion) > 0 Then CelluleDonnees.EntireRow.ClearContents
            Next CelluleExclusion
        Next CelluleDonnees
 
        Set AireDonnees = .Range(.Cells(TitreDonnees, 1), .Cells(DerniereLigneDonnees, DerniereColonneDonnees))
 
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=AireDonnees.Columns(1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .SetRange AireDonnees
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
 
    End With
 
    Set AireDonnees = Nothing
    Set AireExclusions = Nothing
 
    Application.ScreenUpdating = True
 
    MsgBox "Fin de traitement !", vbInformation, "Suppression des exclusions"
 
End Sub

Cordialement.

Merci, cela me parait très logique, néanmoins en ajoutant une feuille que j'ai nommé "Paramètres" et une colonne "ListeAExclure" ceci me met une erreur et le débogage me renvoie directement vers :

Code:

Set AireExclusions = Sheets("Paramètres").Range("ListeAExclure")

Que dois je faire dans ce cas ?

Dans l'attente de vous lire.

22/12/2016, 11h46
Invité

Citation:

Envoyé par Marc-L

Salut Marc,

Effectivement, je n'ai pas tenté le coup. C'est vrai aussi pour le fichier texte, mais cela me paraît plus simple avec un onglet, quitte à le cacher.

Par ailleurs, j'ai rebondis également sur un de tes précédents messages de ce post. J'avais eu aussi l'idée d'utiliser le filtre avancé qui est d'une puissance et d'une rapidité "extraordinaire" sans code. Mais autant cela marche sur une liste des enregistrements à conserver, autant ma sélection sur une liste d'exclusion a foiré.

Cordialement.
22/12/2016, 11h49
Invité

Citation:

Envoyé par Riahi's

néanmoins en ajoutant une feuille que j'ai nommé "Paramètres" et une colonne "ListeAExclure" ceci me met une erreur
Que dois je faire dans ce cas ?

ListeAExclure ne correspond pas à la colonne entière, mais à l'aire formée par les données à exclure (donc moins le titre).

Cordialement.
22/12/2016, 12h01
Riahi's

Merci infiniment, ceci fonctionne à merveilles :)
22/12/2016, 12h23
Marc-L

Citation:

Envoyé par Eric KERGRESSE

Mais autant cela marche sur une liste des enregistrements à conserver, autant ma sélection sur une liste d'exclusion a foiré.

Avec un critère calculé ayant pour résultat VRAI uniquement pour les enregistrements à conserver via EQUIV ou NB.SI ou …

Le filtre avancé pour créer une nouvelle liste sinon formule + tri + effacement global pour modifier la source.
22/12/2016, 12h57
Invité

Citation:

Envoyé par Marc-L

Avec un critère calculé ayant pour résultat VRAI uniquement pour les enregistrements à conserver via EQUIV ou NB.SI ou …

Effectivement, l'idée est bonne.

Cordialement.