Extraction Mails

Y compris Power BI, Power Query et toute autre question en lien avec Excel
Damsa17
Membre habitué
Membre habitué
Messages : 66
Inscrit le : 26 juin 2017
Version d'Excel : 2016

Message par Damsa17 » 16 janvier 2019, 19:36

Bonjour a tous,
Dans mon tableau j'aimerais extraire les mails pour les réunir en une cellule séparer par un ; pour pouvoir envoyer un mail groupé, tout en vérifiant que la cellule contient bien une adresse mail et en évitant les doublons ;-)
Jusque là , j'ai réussi.
Maintenant j'aimerais extraire les adresses mails (si la cellule en contient bien une) mais uniquement du peloton Sapeur (par ex:).
Je vous joins mon fichier.

Merci a vous
Fichiers joints
TEst mail.xlsm
(26.33 Kio) Téléchargé 3 fois
Avatar du membre
Jean-Eric
Fanatique d'Excel
Fanatique d'Excel
Messages : 13'985
Appréciations reçues : 369
Inscrit le : 27 août 2012
Version d'Excel : 2016 FR 32 bits

Message par Jean-Eric » 17 janvier 2019, 09:26

Bonjour,
Une proposition à étudier.
Réalisée avec Power Query (Récupérer et transformer, Excel 2016).
Cdlt.
TEst mail.xlsm
(42.25 Kio) Téléchargé 5 fois
Jean-Eric

Je ne réponds pas aux M.P. non sollicités.
Damsa17
Membre habitué
Membre habitué
Messages : 66
Inscrit le : 26 juin 2017
Version d'Excel : 2016

Message par Damsa17 » 17 janvier 2019, 10:19

Merci,

Je préfererais avec un Macro VBA, mais je vais quand même étudier ca.

:wink:
Avatar du membre
Jean-Eric
Fanatique d'Excel
Fanatique d'Excel
Messages : 13'985
Appréciations reçues : 369
Inscrit le : 27 août 2012
Version d'Excel : 2016 FR 32 bits

Message par Jean-Eric » 17 janvier 2019, 11:24

Re,
Une nouvelle proposition.
Cdlt.
TEst mail.xlsm
(37.99 Kio) Téléchargé 4 fois

Code : Sélectionner et copier le code

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lo As ListObject, Cell As Range, rng As Range, Dict As Object
    If Target.Address = "$I$2" Then
        Set lo = Me.ListObjects("T_Données")
        Me.Cells(15).Value = ""
        With lo
            If .ShowAutoFilter Then .AutoFilter.ShowAllData
            If IsEmpty(Target) Then Exit Sub
            .Range.AutoFilter Field:=9, Criteria1:=Target.Value
            .Range.AutoFilter Field:=7, Criteria1:="=*@*"
            With .AutoFilter.Range
                On Error Resume Next
                Set rng = .Offset(1, 6).Resize(.Rows.Count - 1, 1) _
                          .SpecialCells(xlCellTypeVisible)
                On Error GoTo 0
            End With
        End With
        If rng Is Nothing Then Exit Sub
        Set Dict = CreateObject("Scripting.Dictionary")
        For Each Cell In rng
            Dict(Cell.Value) = Cell.Value
        Next Cell
        Me.Cells(15).Value = Join(Dict.Items, ";")
    End If
End Sub
Jean-Eric

Je ne réponds pas aux M.P. non sollicités.
Damsa17
Membre habitué
Membre habitué
Messages : 66
Inscrit le : 26 juin 2017
Version d'Excel : 2016

Message par Damsa17 » 17 janvier 2019, 18:48

Merci pour cette solution.
Je suis peut être ennuyant, mais ne serait il pas possible de le faire sans filtre?
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message