Alle email adressen filter uit excel

[Hobbit]

Hallo,

Ik heb een excel-sheet waar veel teksten en e-mailadressen in staan. Alles staat door elkaar. Ook komen er e-mailadressen voor in zinnen.

Is er een mogelijkheid om alle e-mailadressen uit het hele bestand te filteren zodat deze vervolgens in een lijst gezet kunnen worden?

Ik krijg het niet voor elkaar.

Ik hoop dat iemand een oplossing heeft.

 

[E v R]

Staan er meerdere emailadressen in 1 zin (Waarbij 1 zin dan ook in 1 cel staat)?

 

[Haaren101]

Wat Eric eigenlijk bedoeld is of je hier een voorbeeld met alle mogelijke variaties kan plaatsen.

Ron

 

[E v R]

Zonder voorbeeld toch een poging:
Plaats onderstaande code in een module en draai de macro tst wanneer de sheet aktief is waar de mailadresen op staan.

De mailadressen worden daarna onderelkaar in kolom A van Blad2 geplaatst. (Dus moet er wel een blad2 zijn!)

De functie GetEmailAddress controleert al (gedeeltelijk) of het om een emailadres gaat, Bart (cow18 ?) heeft onlangs nog een betere functie hiervoor geplaatst.

Function GetEmailAddress(ByVal S As String) As String
'by Rick Rothstein
    Dim x As Long, AtSign As Long
    Dim Locale As String, Domain As String
    Locale = "[A-Za-z0-9.!#$%&'*/=?^_`{|}~+-]"
    Domain = "[A-Za-z0-9._-]"
    AtSign = InStr(S, "@")
    For x = AtSign To 1 Step -1
        If Not Mid(" " & S, x, 1) Like Locale Then
            S = Mid(S, x)
            If Left(S, 1) = "." Then S = Mid(S, 2)
            Exit For
        End If
    Next
    AtSign = InStr(S, "@")
    For x = AtSign + 1 To Len(S) + 1
        If Not Mid(S & " ", x, 1) Like Domain Then
            S = Left(S, x - 1)
            If Right(S, 1) = "." Then S = Left(S, Len(S) - 1)
            GetEmailAddress = S
            Exit For
        End If
    Next
End Function

Sub tst()
    Dim cel As Range, x As Long, Emails As String, Aap As String, i As Long, Emaillijst As Variant
    Aap = "@"
    For Each cel In ActiveSheet.UsedRange
        x = 1
        If InStr(x, cel.Text, Aap, vbTextCompare) Then
            For i = 1 To UBound(Split(cel.Text, Aap))
                If InStr(x, cel.Text, Aap, vbTextCompare) Then Emails = Emails & "|" & GetEmailAddress(Mid(cel.Text, x + 1, Len(cel.Text) - x + 1))
                x = InStr(x + 1, cel.Text, Aap, vbTextCompare)
            Next i
        End If
    Next cel
    If Emails = "" Then Exit Sub
    Emaillijst = Application.Transpose(Split(Emails, "|"))
    Sheets("Blad2").Cells(1, 1).Resize(UBound(Emaillijst)).Value = Emaillijst
End Sub

 

[trucker10]

Zonder voorbeeld De functie GetEmailAddress controleert al (gedeeltelijk) of het om een emailadres gaat, Bart (cow18 ?) heeft onlangs nog een betere functie hiervoor geplaatst.

Staat hier onder post #26 http://www.helpmij.nl/forum/showthr...-via-e-mail.?p=3624093&viewfull=1#post3624093