Effacer lignes dont une cellule contient une adresse mail d'une liste

Bonjour

Dans un tableau de 44 000 lignes je veux effacer toutes les lignes qui ont une cellule qui contient une adresse mail d'une liste d'une centaine d'adresse.

Je ne suis pas expert, mais je pense qu'il s'agit d'écrire une MACRO du genre :

Si dans cette colonne, il y a une cellule qui contient une de ces chaînes de caractère, effacer la ligne qui contient cette cellule.

Merci

Bonjour Michel et bienvenu, bonjour le forum,

Pour te proposer un script 100 % adapté il nous faudrait un fichier exemple qui reprend exactement la structure de ton fichier original. Cela nous permettra de savoir où se trouvent les deux listes (celles des 44 000 lignes et celle de la centaine d'adresse)...

Bonjour,

Qui plus est, pas forcément besoin de macro pour ceci, si ce n'est pas une tâche à effectuer régulièrement.

On met la liste d'une centaine d'adresses dans une autre feuille, un petit rechercheV ou index + equiv qui renvoie ce qu'on veut s'il trouve une correspondance. Puis on filtre, et on garde/supprime ce que l'on veut.
Pas besoin d'avoir bac +12 en VBA du coup ;)

Bonjour Michel, ThauThème, JoyeuxNoel,

Voici un petit d'essai en l'absence de fichier et d'informations précises, comme l'a fait remarqué Thauthème :

option base 1

Sub EffacerLignes()

Dim zone as range, rliste as range
Dim n&, i&, j&, n&, col&
Dim tablo(), valeurs

set zone = activesheet.usedrange 'zone utilisée sur la feuille (adapter si besoin)
set rliste = sheets("nomfeuille").range("nomliste") '<<< adapter référence de la liste
col = zone.columns.count 'nb colonnes de la zone

for i = 1 to zone.rows.count 'pour chaque ligne
    valeurs = application.transpose(application.transpose(zone.rows(i))) 'tableau contenant valeurs ligne
    chaine = join(valeurs) 'valeurs ligne concaténées dans chaine
    if not PRESENCE(chaine, rliste) then 'si chaine contient une des adresses de rliste
        n = n + 1 'incrémentation
        redim preserve tablo(col, n) 'redimension tableau de copie des valeurs à garder
        for j = 1 to col 'parcourt chaque colonne (cad chaque cellule de la ligne en cours)
            tablo(j, n) = zone(i, j) 'tableau prend valeur de la cellule
        next j
    end if
next i

zone.clear 'efface la zone
zone.resize(col, n) = application.transpose(tablo) 'recolle les valeurs sans les lignes indésirables

end sub

Function PRESENCE(chaine As String, Liste As Range) As Boolean

Dim reg As Object
Dim motif$

motif = Join(Application.Transpose(Liste), "|")
Set reg = CreateObject("vbscript.regexp")

With reg
    .ignorecase = True
    .Pattern = motif
    If .test(chaine) Then PRESENCE = True
End With

End Function

Ce n'est pas testé donc je ne garantis rien. Il faudra bien entendu mettre les bonnes références (la liste contenant les mails mais également adapter la range "zone" éventuellement).

Cdlt,

La structure du tableau est simple :

Il s'agit donc de dire à la machine :

Dans ce tableau qui comporte 44 000 lignes,

si dans la colonne C tu trouves une cellule qui contient un des mails suivants (que je peux mettre dans un autre tableau Excel),

tu supprimes la ligne qui contient chacune de ces cellules.

Merci

Et bien je vous invite à essayer le code. Moi, je n'y arriverais pas, je n'ai pas encore de contrôle sur votre machine .

Comme à priori mes remarques sont transparentes sur ce post, je passe la main.

Mais avec toute la bonne volonté dont Michel fait preuve, ça devrait aller vite 😉

J'ai vu tes remarques et tu as probablement raison mais j'avais commencé le code donc j'ai préféré poster ce que j'avais fait, même si ça aurait pu être beaucoup plus simple si on avait su dès le départ que les mails étaient en colonne C et ça pourrait l'être encore plus si on avait la plage (et un tableau structuré)...

Je ne parlais pas pour toi 😉

Et ce n'est pas dit que ce soit la solution optimale. Mais je pars du principe que pour progresser, passer par ces phases via formules est essentiel.

Apres, tout le monde ne souhaite pas forcément progresser.

Bonjour a tous, personnellement je voyait quelque chose comme ça :

Dim i as integer
Dim DerniereLigne as Long
Dim Trouve As Range, PlageDeRecherche As Range
Dim Valeur_Cherchee As String, AdresseTrouvee As String

DerniereLigne = Sheets("Feuil2").Range("A" & Rows.Count).End(xlUp).Row
i = 2

For i = 2 To DerniereLigne

Next1:

Valeur_Cherchee = Sheets("Feuil2").Cells(i, 1)
Set PlageDeRecherche = Sheets("Feuil1").Columns(3)
Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlWhole)

If Trouve Is Nothing Then
        Sheets("Feuil2").Cells(i, 2).Value = "- Non trouvé dans la Feuil1"
        AdresseTrouvee = ""
Else
        AdresseTrouvee = Trouve.Row
        Rows(Trouve.Row).EntireRow.Delete
End If

If AdresseTrouvee = "" Then
Next i
Else
Goto Next1
End If

End Sub

Il faut mettre ta liste de recherche (les adresses mails) sur la collone A de la Feuil2 en partant de la ligne 2

Désolé que le code ne sois pas aussi bien travaillé que celui de 3GB, je débute, mais ça devrait faire ce que tu veut.
Code non testé, je te laisse me faire un retour.

Cdt

@JoyeuxNoel : J'espère bien sinon j'appelle le père fouettard^^.

@evan38 : Et bien, en parlant de progrès ! Wouah . Il y a peu, tu ne maitrisais pas encore la syntaxe d'un if, c'est fort !

Merci bien 3GB, après je me suis beaucoup servis de cette fonctionnalité de recherche donc facile de la ressortir et facile a adapter haha !

PS : Mais quand je voit ton code je me rend compte qu'il y a encore beaucoup de fonctionnalité a découvrir pour ma part ^^

Bonjour le fil, bonjour le forum,

J'avais écris un code et je n'attendais qu'un exemple de Michel pour lui adapter.

Vu que vous avez donné des excellentes réponses et surtout vu que Michel n'est pas foutu de joindre un exemple concret si ce n'est une vulgaire capture d'écran (hé on n'est pas sur PhotoChope ici !), je passe aussi la main...