Extraction Mails

Y compris Power BI, Power Query et toute autre question en lien avec Excel
D
Damsa17
Membre habitué
Membre habitué
Messages : 86
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
TEst mail.xlsm
(26.33 Kio) Téléchargé 3 fois
Avatar du membre
Jean-Eric
Fanatique d'Excel
Fanatique d'Excel
Messages : 14'448
Appréciations reçues : 418
Inscrit le : 27 août 2012
Version d'Excel : O365 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é 6 fois
Jean-Eric

Je ne réponds pas aux M.P. non sollicités.
D
Damsa17
Membre habitué
Membre habitué
Messages : 86
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 : 14'448
Appréciations reçues : 418
Inscrit le : 27 août 2012
Version d'Excel : O365 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
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.
D
Damsa17
Membre habitué
Membre habitué
Messages : 86
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
  • VBA + MAILS
    par spike29 » 1 octobre 2017, 05:17 » dans Excel - VBA
    1 Réponses
    104 Vues
    Dernier message par James007
    1 octobre 2017, 19:34
  • Envoie de mails
    par Brodyeva » 19 février 2019, 23:30 » dans Excel - VBA
    5 Réponses
    76 Vues
    Dernier message par i20100
    22 février 2019, 00:32
  • Envoie de 2 mails simultanément
    par lcmcm » 22 avril 2013, 11:51 » dans Excel - VBA
    3 Réponses
    258 Vues
    Dernier message par lcmcm
    15 mai 2013, 13:43
  • Macro envoi mails
    par hajar91 » 28 avril 2017, 17:19 » dans Excel - VBA
    23 Réponses
    662 Vues
    Dernier message par hajar91
    31 mai 2017, 17:50
  • Envoi automatique de mails
    par Megorihime » 1 octobre 2014, 12:53 » dans Excel - VBA
    2 Réponses
    286 Vues
    Dernier message par Megorihime
    2 octobre 2014, 12:48
  • Suppression de mails en doublons
    par pyf69 » 17 octobre 2013, 10:36 » dans Excel - VBA
    2 Réponses
    66 Vues
    Dernier message par pyf69
    18 octobre 2013, 11:15