XL 2013 Extraire email

[Kinslow2]

Bonjour,

Etant complétement novice en excel, je vous sollicite car j'ai besoin d'une formule simple pour extraire tous les emails d'une liste :

(729, 20, '2', NULL, NULL, 'aaa@resh.com', '$2y$13$U7yFM/TBcPkGeMj2F5G.FOvQkl63RUhElG2fKyNeHo2b0fc77ggwC', NULL),

(1802, 20, '3', 'buyer_1567691914', NULL, 'alexisan.pe@yahoo.fr', '$2y$13$MVrnMiDq.Fb76D3bseZt3.snfgjex3tDeE2dIKee3lAItvoT0BH.m', 'Pv65wsTa'),

Le résultat souhaité :

aaa@resh.com
alexisan.pe@yahoo.fr:

Merci d'avance à vous !

Kinslow

 

[M12]

Bonjour,
A tester avec une fonction personnalisée
(de Mr BOISGONTIER)

 

[sylvanu]

Bonjour Kinslow,
Un essai en PJ avec une fonction perso :

Function TrouveAdresse(C)
    TrouveAdresse = ""
    If C = "" Then Exit Function
    C1 = Split(Split(C, "@")(0), "'")
    C2 = Split(Split(C, "@")(1), "'")
    TrouveAdresse = C1(UBound(C1)) & "@" & C2(0)
End Function

Pour utiliser ce fichier, il vous suffit de mettre vos chaines de caractères en colonne A, vous récupérez les adresses mail en colonne C.
J'ai prévu le fichier pour 500 lignes.

 

[soan]

Bonjour Kinslow2, M12, sylvanu,

bienvenue sur le site XLD !

je te propose le fichier joint ci-dessous ; fais Ctrl e ➯ travail effectué ! j'ai utilisé la méthode des tableaux, donc ça sera très rapide, même si tu as plusieurs milliers de lignes.​

Sub Essai()
  Dim T, n&: n = Cells(Rows.Count, 1).End(3).Row: If n = 1 Then Exit Sub
  Dim chn$, p1%, p2%, i&: n = n - 1: T = [A2].Resize(n, 2)
  For i = 1 To n
    chn = T(i, 1): p2 = InStr(chn, "@")
    If p2 > 0 Then
      p1 = InStrRev(chn, "'", p2)
      If p2 > 0 Then
        p2 = InStr(p2, chn, "'"): If p2 > 0 Then T(i, 2) = Mid$(chn, p1, p2 - p1)
      End If
    End If
  Next i
  [B2].Resize(n) = Application.Index(T, Evaluate("Row(" & "1:" & n & ")"), 2)
End Sub

soan

 

[Kinslow2]

C'est parfait, merci pour toutes vos propositions qui fonctionnent parfaitement !