email aus text

[PeterN]

Hola los Todos!

Ich habe ganz viele Texte nach dem Schema

[{"text":"Hallo! Ich würde mich sehr freuen, wenn Du dich meldest!\n\nIch bin am besten am Wochenende zu erreichen.\nIch melde mich normalerweise sehr kurzfristig.\nSchreib mir einfach per Mail an max.muster@mustermann.de\nIch freue mich auf Deine Antwort."}]

in Spalte A.

(Fast) alle Texte enthalten eine Emailadresse die ich gerne ausgliedern möchte.

Ich bräuchte eine Lösung wie ich nur die Emailadresse aus den Texten in Spalte A in Spalte B bekomme.

Danke und Gruss

Peter

[Kuwer]

Hallo Peter,

per benutzerdefinierter Funktion (UDF) z.B. so:

Public Function EmailAdresse(Zeichenfolge As String) As String

  Dim i As Long

  Dim vTeile As Variant

  vTeile = Split(Zeichenfolge, " ")

  For i = 0 To UBound(vTeile)

    If InStr(1, vTeile(i), "@") Then

      EmailAdresse = Left(vTeile(i), InStr(1, vTeile(i), "\n") - 1)

      Exit For

    End If

  Next i

End Function

	A	B
1	[{"text":"Hallo! Ich würde mich sehr freuen, wenn Du dich meldest!\n\nIch bin am besten am Wochenende zu erreichen.\nIch melde mich normalerweise sehr kurzfristig.\nSchreib mir einfach per Mail an max.muster@mustermann.de\nIch freue mich auf Deine Antwort."}]	max.muster@mustermann.de

Formeln der Tabelle

Zelle Formel B1 =EmailAdresse(A1)

Gruß Uwe

[PeterN]

Hi Uwe!

Danke für Deine superschnelle Antwort und den Code.

Leider bekomme ich das Ganze mal wieder nicht zum Laufen.

Ich habe die letzten Stunden vergeblich versucht Deine UDF in einer neuen Liste einzufügen und dann zu nutzen. Alles was ich bzgl. UDF einfügen gegoogelt habe, klingt so einfach, nur wenn ich es dann so mache, geht es trotzdem nicht. Mal steht in Spalte B gar nix, beim nächsten Versuch NAME, dann WERT usw. Nur eine Emailadresse steht da leider nie.

Selbst wenn ich ein Liste mit einem funktionierendem Makro nehme und nur das Makro austausche geht nix.

Kannst Du mir bitte eine Liste schicken in der Dein Code läuft?

Danke und Gruss

Peter

[Kuwer]

Hallo Peter,


  email aus text_Kuwer.xlsb (Größe: 13,32 KB / Downloads: 5)

Gruß Uwe