Emailadressen extrahieren

Bild

Betrifft: Emailadressen extrahieren von: Peter
Geschrieben am: 09.02.2005 13:09:55

Hallo,
ich verzweifle an folgender Aufgabenstellung:
Ich habe in einer Spalte einen Text, der Emailadressen beinhaltet.
Nun soll in der Spalte rechts daneben nur die Emailadressen, die in dem Text vorkommen stehen.
Das soll über alle Zeilen durchgeführt werden.
Wie kann ich das lösen?

LG

Peter

Bild


Betrifft: AW: Emailadressen extrahieren von: Dr.
Geschrieben am: 09.02.2005 13:20:02

Ich würd als Schritt 1 mal über Daten|Text in Spalten den ganzen Schmarrn über die Leerzeichen trennen. Dann in jeder Zelle einer Zeile nach dem @ suchen und übertragen.


Bild


Betrifft: AW: Emailadressen extrahieren von: Peter
Geschrieben am: 09.02.2005 13:29:52

Danke für den Tip. Hab´s gleich ausprobiert. Aber sobald eine Zelle einen Zeilenumbruch hat, sind die nachfolgenden Zellen leer.

Damit viellecht klarer ist, was ich möchte:
Wir verschicken monatlich Newsletter. Die Emailadressen können sich Interessenten selbst auf der Website eintragen. Daher gibt es immer eine hohe Zahl an Mails die zurückkommen, wenn die Adresse nicht gültig ist, oder der Mailspace voll ist.... So, und nun muss ich in jedes Rückläufermail reinschauen, die Mailadresse raussuchen und aus der DB schmeißen. Da das aber immer mehr wird, möchte ich das über ein Makro machen, das die Mailadressen aus dem Bodytext ins Excel exportiert.
Ich habe es nun geschafft, den Bodytext ins Access bzw. ins Excel zu bekommen. Jetzt stehe ich aber bei dem Versuch an, die Mailadresse aus dem Text zu extrahieren.

Peter


Bild


Betrifft: AW: Emailadressen extrahieren von: Galenzo
Geschrieben am: 09.02.2005 13:35:00

hab' mal eben eine nette "Monster"-Formel zusammengebastelt.
Diese zieht dir eine Mail-Adresse aus 'ner Zelle, wenn vorher und nachher ein Leerzeichen steht. Vielleicht kannst du's ja gebrauchen, ansonsten zur allgemeinen Belustigung:

=TEIL(A1;FINDEN("#";WECHSELN(A1;" ";"#";LÄNGE(LINKS(A1;FINDEN("@";A1)))-LÄNGE(WECHSELN(LINKS(A1;FINDEN("@";A1));" ";""))))+1;FINDEN("@";A1)-FINDEN("#";WECHSELN(A1;" ";"#";LÄNGE(LINKS(A1;FINDEN("@";A1)))-LÄNGE(WECHSELN(LINKS(A1;FINDEN("@";A1));" ";"")))))&TEIL(A1;FINDEN("@";A1)+1;FINDEN(" ";A1;FINDEN("@";A1))-FINDEN("@";A1))

@Alle: Ich bin natürlich immer an "Gegen"vorschlägen und Optimierungen interessiert....


Bild


Betrifft: AW: Emailadressen extrahieren von: Peter
Geschrieben am: 09.02.2005 14:00:53

Hi,

Super! Das Funzt! Nicht ganz richtig, aber immerhin. Was noch nicht stimmt, ist folgendes:
Es sind auch ziemlich oft vor und nach der Adresse Zeilenumbrüche drin.
Das sieht dann so aus: blabla[][]email@adresse.at[][]blabla
[]=Zeilenumbruchsymbol
Also müsste das so sein, dass entweder nach Leerzeichen oder nach Zeilenumbruch gesucht werden soll. Wenn ich das [] nun in die Formel einfüge, habe ich dann in der Formel den Zeilenumbruch. Wenn ich vorher in meinem Text mit SÄUBERN drangehe, sind die Leerzeichen zwar weg, aber dafür sieht die Adresse dann so aus:
Blablablaemail@adresse.atblablabla
Wie kann ich Zeilenumbrüche gegen Leerzeichen austauschen? Wenn ich =WECHSELN(A2;chr(13);" ") eingebe, dann steht in der Zelle #NAME?

PEter


Bild


Betrifft: AW: Emailadressen extrahieren von: Ulf
Geschrieben am: 09.02.2005 14:15:52

Nicht chr(13) sondern Zeichen(13)

Ulf


Bild


Betrifft: AW: Emailadressen extrahieren von: Peter
Geschrieben am: 09.02.2005 14:31:02

Hallo,
Ich bin heute schon nicht mehr aufnahmefähig :-( Ich raff das alles nicht.
Hier habe ich mal eine Beispieldatei hingestellt: https://www.herber.de/bbs/user/17728.xls
Wie ich es drehe und wende, irgendwas geht da immer nicht...

LG

Peter


Bild


Betrifft: AW: Emailadressen extrahieren von: bst
Geschrieben am: 09.02.2005 15:11:14

Hallo Peter,

Versuch's mal mit sowas.

Gruß, Bernd
--
Option Explicit

Sub JustForFun()
   Dim r As Range
   Dim i%, j%
   Dim arr$(), hilf$
   
   For Each r In Intersect(ActiveSheet.UsedRange, Range("A:A"))
      hilf = Replace(r.Value, Chr(9), " ")
      hilf = Replace(hilf, Chr(10), " ")
      hilf = Replace(hilf, Chr(13), " ")
      arr = Split(hilf, " ")
      j = 1
      For i = 0 To UBound(arr)
         If arr(i) Like "*@*" Then
            r.Offset(0, j) = arr(i)
            j = j + 1
         End If
      Next
   Next
End Sub



Bild


Betrifft: AW: Emailadressen extrahieren von: bst
Geschrieben am: 09.02.2005 15:11:18

Hallo Peter,

Versuch's mal mit sowas.

Gruß, Bernd
--
Option Explicit

Sub JustForFun()
   Dim r As Range
   Dim i%, j%
   Dim arr$(), hilf$
   
   For Each r In Intersect(ActiveSheet.UsedRange, Range("A:A"))
      hilf = Replace(r.Value, Chr(9), " ")
      hilf = Replace(hilf, Chr(10), " ")
      hilf = Replace(hilf, Chr(13), " ")
      arr = Split(hilf, " ")
      j = 1
      For i = 0 To UBound(arr)
         If arr(i) Like "*@*" Then
            r.Offset(0, j) = arr(i)
            j = j + 1
         End If
      Next
   Next
End Sub



Bild


Betrifft: AW: Emailadressen extrahieren von: Udo
Geschrieben am: 09.02.2005 15:30:13

Geil!

Udo


Bild


Betrifft: AW: Emailadressen extrahieren von: Peter
Geschrieben am: 09.02.2005 15:51:34

Super!
Genau das ist es!
DANKE!!


 Bild

Beiträge aus den Excel-Beispielen zum Thema "Emailadressen extrahieren"