Datum

Titel

25.04.2024 21:13:13

Kalenderwochen addieren

25.04.2024 21:06:05

Duplikate entfernen

25.04.2024 18:41:19

vba Zeilen duplizieren ab aktiver Zeile bis letzte Zeile

25.04.2024 18:22:55

Zeilen mit bestimmtem Datum in andere Mappe übertragen

Du findest keine passende Antwort auf Deine Frage?

Stelle Deine Frage in unserem Live-Forum

Archiv - Navigation

640to644

Aktuelles Verzeichnis

Verzeichnis Index

Übersicht Verzeichnisse

Vorheriger Thread

Rückwärts Blättern

Nächster Thread

Vorwärts blättern

HERBERS

Excel-Forum (Archiv)

20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Rückwärts Blättern

Aktuelles Verzeichnis

Übersicht Verzeichnisse

Vorwärts blättern

Inhaltsverzeichnis

Emailadresse aus Zelle extrahieren

Forumthread: Emailadresse aus Zelle extrahieren
15 Beiträge zu diesem Forumthread
Anzeige
314 Threads zu ähnlichen Themen
VBA Beispiele zu verwandten Themen

Top 100 Forumthreads

26.07.2005 16:15:00

Raub

Servus,
ich habe meine Schwirigkeiten bei folgenden Problem:
Task: Aus einer Zelle mit beliebigen Inhalt, die E-Mail Adresse extrahieren.
Beschreibung: In einer Zelle stehen neben Name, Telefonnummer, Land auch irgendwo die E-Mail Adresse.
Problem: Ich versuche mit eine For Schleife die Stelle herauszufinen wo sich das @ Zeichen befindet (mit dem Mid()-Objekt). Nächster Schritt wäre den Anfang der Emailadresse herauszufinden und dann noch das Ende.
Dies ist mir leider nur mit Hilfe von vielen For Schleifen und If Abfragen gelungen.
Kennt jemand eine bessere Methode?
Danke im Voraus,
Philipp

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

ERGÄNZUNG

26.07.2005 17:01:00

Philipp
AW: ERGÄNZUNG

26.07.2005 17:19:56

Sigi
AW: ERGÄNZUNG

26.07.2005 17:59:18

Philipp
AW: ERGÄNZUNG

27.07.2005 01:46:30

MichaV
AW: ERGÄNZUNG

27.07.2005 11:18:42

Philipp
AW: ERGÄNZUNG

27.07.2005 11:35:48

MichaV
AW: ERGÄNZUNG

27.07.2005 11:56:25

Philipp
AW: ERGÄNZUNG

27.07.2005 12:10:21

MichaV
Lösung

27.07.2005 13:04:58

MichaV
AW: Lösung

27.07.2005 13:39:38

Philipp
AW: Lösung

27.07.2005 13:43:11

MichaV
Endgültige Lösung

27.07.2005 15:42:46

Philipp
AW: Emailadresse aus Zelle extrahieren

26.07.2005 17:05:03

Dr.
AW: Emailadresse aus Zelle extrahieren

26.07.2005 17:18:40

Philipp
AW: Emailadresse aus Zelle extrahieren

26.07.2005 17:23:52

Dr.

ERGÄNZUNG

26.07.2005 17:01:00

Philipp

Zur besseren Verständnis:
Die Zelle hat beispielsweise folgenden Inhalt:
"Philipp Raub, Tel: 089/xxxxxx, MUC/GER, philippraub@gmx.de, 26.07.05"
Aus einer solchen Zeichenfolge soll nur die E-Mail Adresse an eine Variable übergeben werden.
Was die Sache erschwert, das jeder Nutzer weitere oder auch keine Angaben außer der E-Mail Adresse angibt.

AW: ERGÄNZUNG

26.07.2005 17:19:56

Sigi

Hallo Philipp,
dein Problem ist nicht ganz einfach. So eine E-Mail-Adresse kann ja sehr unterschiedlich
aussehen. Und wenn ein @-Zeichen in der Zelle vorhanden ist, muss es ja noch keine Mail-
Adresse sein.
Folgende Funktion sollte ca. 99% der Fälle lösen ...
Function MailAdrAusText(Text As String) As String Dim PosAff As Long Dim PosDot As Long Dim PosAnf As Long Dim PosEnd As Long Dim Tx As String Dim i As Long Application.Volatile PosAff = InStr(1, Text, "@") If PosAff > 0 Then For i = PosAff To Len(Text) If Mid(Text, i, 1) = " " Then PosEnd = i - 1 Exit For End If Next i If PosEnd = 0 Then PosEnd = Len(Text) For i = PosAff To 1 Step -1 If Mid(Text, i, 1) = " " Then PosAnf = i + 1 Exit For End If Next i If PosAnf = 0 Then PosAnf = 1 If PosEnd - PosAnf >= 5 Then Tx = Mid(Text, PosAnf, PosEnd - PosAnf + 1) If Tx <> "" Then PosAff = InStr(1, Tx, "@") If PosAff > 1 Then PosDot = InStr(PosAff, Tx, ".") If PosDot = 0 Or PosDot - PosAff < 2 Then Tx = "" End If Else Tx = "" End If End If End If End If If Right(Tx, 1) = "," Or _ Right(Tx, 1) = ";" Or _ Right(Tx, 1) = "." Then Tx = Left(Tx, Len(Tx) - 1) End If MailAdrAusText = Tx End Function
Gruß
Sigi

AW: ERGÄNZUNG

26.07.2005 17:59:18

Philipp

Funktioniert schon ganz gut. In der Zelle wird nur ein @ sein, das ist sicher.
Probleme bekomme ich aber wenn jemand vor der Emailadress ein Zeilenumbruch statt eines ",", ";" bzw " " eingibt gibt die Funktion das Zeichenfolge davor mit an.

AW: ERGÄNZUNG

27.07.2005 01:46:30

MichaV

Hallo,
das in ein allgemeines Modul:

Option Explicit
Function Email(t, e) As String
't= Dein String
'e= Das Trennzeichen

Dim f
Dim i As Integer
If InStr(t, "@") = 0 Then Exit Function
f = Split(t, e)
For i = 0 To UBound(f)
  If InStr(f(i), "@") > 0 Then
    Email = Trim(f(i))
    Exit Function
  End If
Next i
End Function

und dann siehts so aus:

Tabelle1

	A	B	C
1	Philipp Raub, Tel: 089/xxxxxx, MUC/GER, philippraub@gmx.de, 26.07.05	philippraub@gmx.de
2	philippraub@gmx.de	philippraub@gmx.de
3	Philipp Raub, Tel: 089/xxxxxx, MUC/GER, philippraub@gmx.de, 26.07.05	philippraub@gmx.de	,

Formeln der Tabelle

B1 : =email(A1;",")
B2 : =email(A2;",")
B3 : =email(A3;C3)

Diagramm - Grafik - Excel Tabellen einfach im Web darstellen Excel Jeanie HTML 3.0 Download
Gruß- Micha
PS: Rückmeldung wäre nett.

AW: ERGÄNZUNG

27.07.2005 11:18:42

Philipp

Erst einmal vielen Dank für Deine Bemühungen. Deine Funktion arbeitet eigentlich ganz gut. Einziges Problem, das Trennzeichen kan ein ",", ".", " " oder ein Zeilenumbruch sein. Da ich täglich an die 100 solcher Zellen zu bearbeiten habe, wäre es sehr viel Aufwand das händisch einzutragen.
Gruß,
Philioo

AW: ERGÄNZUNG

27.07.2005 11:35:48

MichaV

Hallo,
1. Frage: ist Dein Problem eigentlich durch die anderen Vorschläge gelöst?
Wenn nicht, dann:
2. Frage: Ist es pro Zeile immer eine Art von Trennzeichen (also immer Komma oder immer Punkt) oder sind die Trennzeichen völlig durcheinander?
(Dein Beispiel hätte also besser lauten sollen
Philipp Raub, Tel: 089/xxxxxx, MUC/GER. philippraub@gmx.de
26.07.05)
?
Gruss- Micha
PS: Rückmeldung wäre nett.

AW: ERGÄNZUNG

27.07.2005 11:56:25

Philipp

Zur 1. Frage:
Leider nein, weil ich das Problem mit dem Zeilenumbruch immer noch habe (bei allen Funktionen).
Inzwischen habe ich auch eine primitive eigene Funktion gebastelt, die aber leider auch nicht das Problem mit dem Zeilenumbruch löst.
Hier mein Makro:
____________________
Sub EmailAddress() Dim L, M, N, At, E, B As Integer Dim Email As String For L = 1 To Len(ActiveCell.Value) If Mid(ActiveCell.Value, L, 1) = "@" Then At = L GoTo EndEmailAddress End If Next L EndEmailAddress: For M = At To Len(ActiveCell.Value) If Mid(ActiveCell.Value, M, 1) = "" Or Mid(ActiveCell.Value, M, 1) = "," _ Or Mid(ActiveCell.Value, M, 1) = Chr(13) Or Mid(ActiveCell.Value, M, 1) = Chr(10) Then E = M GoTo BeginEmailAddress End If Next M BeginEmailAddress: For N = At To 1 Step -1 If Mid(ActiveCell.Value, N, 1) = "" Or Mid(ActiveCell.Value, N, 1) = "," _ Or Mid(ActiveCell.Value, N, 1) = Chr(13) Or Mid(ActiveCell.Value, N, 1) = Chr(10) Then B = N End If Next N Email = Mid(ActiveCell.Value, B, E - B) MsgBox "Die Emailadresse lautet: " & Email End Sub
__________________________
Zur zweiten Frage:
Es ist total User abhängig. Die Leute werden angewiesen in eine bestimmte Zelle ihren Namen, ihre Emailadress, Telefonnummer und Abteilung eingeben sollen. Nur leider mach jeder User es anders. Der eine schreibt die Infos mit Kommers, der andere mit Zeilenumbrüchen.
Wäre dankbar, wenn ich diese dummen Zeilenumbrüche wegbekomme.
Gruß, Philipp

AW: ERGÄNZUNG

27.07.2005 12:10:21

MichaV

Hallo,
dann so:
Nimm Deinen String, ersetze alle Kommas und alle Chr(10) durch Punkte. Das amchst Du mit Worksheetfunction.Substitute.
Dann behandle den String mit meiner Funktion, hänge aber das folgende Element noch ran Email = Trim(f(i))+Trim(f(i+1))
Das sollte funzen.
Ich geh jetzt Mittag essen und schaue dann, ob Du es hingekriegt hast. Solltest Du, beiu Deinem Level ;o)
Mahlzeit!- Micha

Lösung

27.07.2005 13:04:58

MichaV

Hallo,
so, keine Zuarbeit von Dir, also hier das Ergebnis ;o)
Ich hab es noch ein bischen Verfeinert, das Leerzeichen als Trennzeichen wird ebenfalls erkannt.

Option Explicit
Function Email(t) As String
Dim f() As String
Dim i As Integer
If InStr(t, "@") = 0 Then Exit Function
'Ersetze Leerzeichen, Zeilenumbrüche und Kommas mit Punkten
'Das geht, weil Email-Adressen NIE Leerzeichen oder Zeilenumbrüche und IMMER
'genau einen Punkt enthalten.

t = WorksheetFunction.Substitute( _
    WorksheetFunction.Substitute( _
    WorksheetFunction.Substitute( _
    WorksheetFunction.Substitute(t, _
    " ", "."), _
    Chr(13), "."), _
    Chr(10), "."), _
    ",", ".")

'Den String in Elemente aufteilen, Trennzeichen der Elemente ist der Punkt
f = Split(t, ".")
'Das Element mit @ suchen. Dieses und das Element dahinter ergeben -mit Punkt
'verbunden- die gesuchte Email- Adresse

For i = 0 To UBound(f)
  If InStr(f(i), "@") > 0 Then
    Email = Trim(f(i)) + "." + f(i + 1)
    '     = "Email@Domain" + "." + "de"
    Exit Function
  End If
Next i
End Function

Gruss- Micha
PS: Rückmeldung wäre nett.

AW: Lösung

27.07.2005 13:39:38

Philipp

Leider ein kleiner Fehler, da Emails nicht immer genau einen Punkt habe, sondern im meinem Fall eigentlich immer 2 (manchmal auch drei) Punkte habe, (BSP: Philipp.AL.Raub@gmx.de).
Ich änder einfach die Umformung der Zeichen in * stat eines Punktes.
Danke dir für die schnelle Hilfe, war auch gerade Essen.
Gruß,
Philipp

AW: Lösung

27.07.2005 13:43:11

MichaV

Hallo,
ja klar, hast Recht! Warum einfach, wenns auch kompliziert geht ;o)
Gruss- Micha

Endgültige Lösung

27.07.2005 15:42:46

Philipp

Vielen Dank für die Hilfe, für alle die es interessiert hier die endgültige Lösung meines Problemes:


Function Email(t) As String
Dim f() As String
Dim i As Integer
If InStr(t, "@") = 0 Then Exit Function
'Ersetze Leerzeichen, Zeilenumbrüche und Kommas mit Punkten
'Das geht, weil Email-Adressen NIE Leerzeichen oder Zeilenumbrüche und IMMER
'genau einen Punkt enthalten.
t = WorksheetFunction.Substitute( _
WorksheetFunction.Substitute( _
WorksheetFunction.Substitute( _
WorksheetFunction.Substitute(t, _
" ", "*"), _
Chr(13), "*"), _
Chr(10), "*"), _
",", "*")
'Den String in Elemente aufteilen, Trennzeichen der Elemente ist der Stern
f = Split(t, "*")
'Das Element mit @ suchen. Dieses und das Element dahinter ergeben -mit Punkt
'verbunden- die gesuchte Email- Adresse
For i = 0 To UBound(f)
If InStr(f(i), "@") > 0 Then
Email = Trim(f(i))
Exit Function
End If
Next i
End Function

Ciao,Philipp

AW: Emailadresse aus Zelle extrahieren

26.07.2005 17:05:03

Dr.

Warum nicht Daten/Text in Spalten/Trennzeichen "Komma" ?

AW: Emailadresse aus Zelle extrahieren

26.07.2005 17:18:40

Philipp

Darauf habe ich leider keinen Einfluss. Die Daten werden beliebig eingetragen, an Vorgaben hält sich da keiner.

AW: Emailadresse aus Zelle extrahieren

26.07.2005 17:23:52

Dr.

Aus dem, was Du als Problem beschrieben hast, entnehme ich, dass Dir eine ungeordnete Liste vorliegt, wo die Einträge durch Kommas getrennt sind.
Dann funktioniert die Vorgehensweise über Daten/Text in Spalten ideal.