ne garder que lignes contenant @ et supprimer les autres

[charlyrac]

bonjour, et tout est dans le titre je crois........ah non, il manque la précision selon laquelle je suis un "bleu" concernant tous les codes macro formule etc......

et que dans certains classeurs énormes, autant de lignes qu'un classeur peut en contenir, je voudrais supprimer touts les lignes ou ne figure pas le caractère @

merci d'avance de votre énergie à éclairer mon plafonnier

charly

 

[Grand Chaman Excel]

Re : ne garder que lignes contenant @ et supprimer les autres

Bonsoir charlyrac,

Questions :
Est-ce que les données sont sur plusieurs colonnes ou dans une colonne particulière?
Est-ce que le @ peut être dans n'importe qu'elle colonne d'une même ligne?

Merci de préciser

 

[charlyrac]

Re : ne garder que lignes contenant @ et supprimer les autres

bonsoir Grand Chaman,

les données peuvent se trouver dans plusieurs colonnes et le @ peut se trouver n'importe où dans la ligne

 

[Grand Chaman Excel]

Re : ne garder que lignes contenant @ et supprimer les autres

Re-bonsoir,

Voici une proposition. Attention, le temps d'exécution de la macro sera long s'il y a beaucoup de lignes / colonnes.
En supposant que les données commencent en A1...
Pour utiliser la macro, se placer dans une cellule de la "BD". La plage de travail est définie selon la région autour de cette cellule. Ensuite, la macro balaie à partir de la dernière ligne jusqu'à la ligne 1. Pour chaque ligne, vérifie l'ensemble des cellules dans toutes les colonnes à la recherche de "@". Si ne trouve rien, efface la ligne.

Sub EffacerLignes()
' Efface toutes les lignes si aucune cellule dans la ligne
' ne contient le caractère @
' Attention : long temps d'exécution

    Dim rg As Range, c As Range, rg2 As Range
    Dim i As Long, nbCol As Long, nbLig As Long, efface As Boolean
    
    
    Application.ScreenUpdating = False
    Set rg = ActiveCell.CurrentRegion   'toutes les données
    nbLig = rg.Rows.Count
    nbCol = rg.Columns.Count
    
    For i = nbLig To 1 Step -1
        Set rg2 = Cells(i, 1).Resize(1, nbCol)
        efface = True
        For Each c In rg2
            If InStr(1, c.Text, "@") > 0 Then efface = False
        Next c
        If efface Then Rows(i).EntireRow.Delete
        
        If i Mod 500 = 0 Then Application.StatusBar = i 'compteur
    Next i
    
    Application.ScreenUpdating = True

End Sub

A+

 

[charlyrac]

Re : ne garder que lignes contenant @ et supprimer les autres

bonjour Grand Chaman,

merci de ton aide, j'ai inscrit tout le code et exécuté, mais rien ne se passe, aussi je joins un bout de fichier pour la meilleure compréhension, et pendant que j'y suis, quand les lignes ne contenant pas @ auront été supprimées, je crois qu'il serait possible d'obtenir que chaque adresse mail, puisque c'est cela dont il s'agit,soit accolée à la suivante avec juste un séparateur "point-virgule" ";"........ce serait génial!

bien excellemment, enfin je ne parle pas pour moi

 

[david84]

Re : ne garder que lignes contenant @ et supprimer les autres

Bonjour charlyrac, Grand Chaman,
Que fait-on s'il existe plusieurs occurrences d'une même adresse (doublons) ?
La syntaxe des adresses mail présentes dans le fichier est-elle obligatoirement bonne ou doit-elle être vérifiée ?
A+

 

[charlyrac]

Re : ne garder que lignes contenant @ et supprimer les autres

bonjour David84,

le mieux serait de supprimer les doublons à l'identique.....Quant à la syntaxe abcdef@abcdef.abcdef, considérons qu'elle soit bonne.....

 

[david84]

Re : ne garder que lignes contenant @ et supprimer les autres

Re

je crois qu'il serait possible d'obtenir que chaque adresse mail, puisque c'est cela dont il s'agit,soit accolée à la suivante avec juste un séparateur "point-virgule" ";"........ce serait génial!

Tu ne pourras pas avoir dans une seule cellule toutes les adresses mail : elles sont trop nombreuses et dépasse la capacité de contenance d'une cellule en nombre de caractères.
Par contre je pense qu'il est possible de les scinder par groupe (de 50 par exemple), ce qui t'évitera en outre de passer sous le seuil à partir duquel un nombre trop important d'adresses mail lors d'un envoi peut passer pour un spam.
Cela te convient-il ?
A+

 

[Jacou]

Re : ne garder que lignes contenant @ et supprimer les autres

bonjour charlyrac,

dans ton exemple (les données étant dans une seule colonne) tu peux le faire directement avec les commandes d'Excel.
tu ajoutes une ligne pour le titre (liste par exemple).
tu sélectionnes ta colonne A et tu mets le filtre automatique.
tu filtres sur le critère "ne contient pas "à"".
tu sélectionnes toutes les lignes filtrées et tu les supprimes (commande "supprimer la ligne").
tu "effaces" le filtre.
et tu n'as plus qu'à supprimer les doublons (onglet "données" commande "supprimer les doublons".

tu pourras ensuite utiliser ton tableau pour faire un e-mailing.

fais-en bon usage

à+

 

[charlyrac]

Re : ne garder que lignes contenant @ et supprimer les autres

ah très bien et pourrait-on convenir de 99 adresses puisque je crois qu'en Cci le nombre maxi est 100.... pour terminer, d'excel, je compte faire un copier coller vers blocNOTE des adresses ainsi accolées........bien ou pas?

 

[charlyrac]

Re : ne garder que lignes contenant @ et supprimer les autres

bonjour charlyrac,

dans ton exemple (les données étant dans une seule colonne) tu peux le faire directement avec les commandes d'Excel.
tu ajoutes une ligne pour le titre (liste par exemple).
tu sélectionnes ta colonne A et tu mets le filtre automatique.
tu filtres sur le critère "ne contient pas "à"".
tu sélectionnes toutes les lignes filtrées et tu les supprimes (commande "supprimer la ligne").
tu "effaces" le filtre.
et tu n'as plus qu'à supprimer les doublons (onglet "données" commande "supprimer les doublons".

tu pourras ensuite utiliser ton tableau pour faire un e-mailing.

fais-en bon usage

à+

Bonjour Jacou,

oui je viens d'essayer les filtres par tâtonnements, c'est OK mais ensuite j'ai un grand nombre de lignes avec une adresse par ligne, je voudrais qu'elles se groupent par 99 et séparées seulement par un point virgule....

 

[Jacou]

Re : ne garder que lignes contenant @ et supprimer les autres

Bonjour,
oui mais tu peux directement utiliser cette liste en faisant comme je te l'ai dit un e-mailing avec Word (fonction Publipostage et message électronique)

 

[charlyrac]

Re : ne garder que lignes contenant @ et supprimer les autres

Bonjour,
oui mais tu peux directement utiliser cette liste en faisant comme je te l'ai dit un e-mailing avec Word (fonction Publipostage et message électronique)

la fonction message électronique de word n'est pas disponible, je viens de voir!et ça me parait plus complexe par ce moyen.....non?

 

[charlyrac]

Re : ne garder que lignes contenant @ et supprimer les autres

Re

Tu ne pourras pas avoir dans une seule cellule toutes les adresses mail : elles sont trop nombreuses et dépasse la capacité de contenance d'une cellule en nombre de caractères.
Par contre je pense qu'il est possible de les scinder par groupe (de 50 par exemple), ce qui t'évitera en outre de passer sous le seuil à partir duquel un nombre trop important d'adresses mail lors d'un envoi peut passer pour un spam.
Cela te convient-il ?
A+

h très bien et pourrait-on convenir de 99 adresses puisque je crois qu'en Cci le nombre maxi est 100.... pour terminer, d'excel, je compte faire un copier coller vers blocNOTE des adresses ainsi accolées........bien ou pas?

 

[david84]

Re : ne garder que lignes contenant @ et supprimer les autres

Re
ci-joint fichier à tester soigneusement de ton côté :

Sub Extraire_mail()
Dim i&, j&, k&, T(), T2, dico As Object, Nb As Double, temp As String
Application.ScreenUpdating = False
[B:B].ClearContents
T = [A1].CurrentRegion.Value
Set dico = CreateObject("scripting.dictionary")
For i = LBound(T, 2) To UBound(T, 2)
    For j = LBound(T) To UBound(T)
        If InStr(1, T(j, i), "@") > 0 Then
            dico(T(j, i)) = dico(T(j, i))
        End If
    Next j
Next i
T2 = dico.keys
Nb = Int(dico.Count \ 100)
    For i = LBound(T2) To Nb
        For j = LBound(T2) To Application.WorksheetFunction.Min(100, dico.Count - k - 1)
                temp = temp & T2(k) & ";": k = k + 1
        Next j
        Cells(i + 1, 2) = temp: temp = ""
    Next i
Application.ScreenUpdating = True
End Sub

A+