Zahlenfolge (telefonnummern) aus Text auslesen

Baedu · 2024-06-17T08:22:08+00:00

Hallo zusammen Ich habe folgendes Problem. In Spalte B, in den einzelnen Zellen sind Texte. In dieses Texten sind bis zu drei verschiedenen Telefonnummern enthalten in unterschiedlicher Schreibweise. Erkennen möchte ich die Telefonnummern als Zahlenfolge von min 8, max. 16 Zahlen ohne Buchstaben oder Sonderzeichen dazwischen, ausgenommen Leerzeichen. Dann sollen die erkannten Zahlenfolgen (Telefonnummern) jeweils in die Spalte C, erste Zahlenfolge, D zweite Zahlenfolge und E dritte Zahlenfolge eingefügt werden. Bisher hatte ich mit VBA versucht, mittels Zeichensuche z.B. « +» oder « 00» und die anschliessenden 16 Zeichen zu kopieren. Das bringt mir jeweils aber nur die letzte Telefonnummer, nicht alle, und ist unzuverlässig. Wer hat mir eine Idee? Danke

Moin!

Diese function löscht alle Zeichen ausser Zahlen und Leerstellen
Mit textteilen werden anschließend die Nummern auf die Felder aufgeteilt. Kannst du damit was anfangen?

-	A	B	C	D	E
1	Test mit: tel 09142-6736 Test mit: tel 09142-6736 Test mit: tel 09142-6736 Test mit: tel 09142-6736	091426736	091426736	091426736	091426736

-	A	B	C	D	E
1	Test mit: tel 09142-6736 Test mit: tel 09142-6736 Test mit: tel 09142-6736 Test mit: tel 09142-6736	=TEXTTEILEN(Buchstaben_aus_string_entfernen(A1);" ";;1)



Function Buchstaben_aus_string_entfernen(Optional begriff As String) As String

    'Nur Ziffern bleiben bestehen, ASCII 48-57

    Dim i As Long

    Dim ausgabe1 As String

    

    If begriff = vbNullString Then begriff = ActiveCell.value

    

    For i = 1 To Len(begriff)

        If Asc(Mid(begriff, i, 1)) >= 48 And Asc(Mid(begriff, i, 1)) = 57 Or Asc(Mid(begriff, i, 1)) = 32 Then ausgabe1 = ausgabe1 & Mid(begriff, i, 1)

    Next i

    

    Buchstaben_aus_string_entfernen = ausgabe1

End Function

Gruß, MCO

Hi
dann probier mal diese Function

Function tel(txt As String, pos As Long, Optional Mindestlänge As Long = 8) As String

Dim x

Dim i As Long

Dim txt2 As String

Dim chk As Long

Dim Zähler As Long



'-überflüssige Zeichen raus

For Each x In Array("(", ")", " ", "-", "/", "+")

    txt = Replace(txt, x, "")

Next



'-trennzeichen vor und nach Ziffernblock

txt2 = IIf(Left(txt, 1) Like "#", "|" & Left(txt, 1), Left(txt, 1))

For i = 2 To Len(txt)

    chk = (Mid(txt, i - 1, 1) Like "#") + (Mid(txt, i, 1) Like "#")

    If chk = -1 Then txt2 = txt2 & "|"

    txt2 = txt2 & Mid(txt, i, 1)

Next



'-Zifferblöcke auf Länge prüfen (Telefonnummer) und ausgeben

x = Split(txt2, "|")

For i = 1 To UBound(x) Step 2

    If Len(x(i)) >= Mindestlänge Then

        Zähler = Zähler + 1

        If Zähler = pos Then

            tel = x(i)

            Exit Function

        End If

    End If

Next

tel = ""

End Function

die funktioniert so:
zuerst werden alle Klammern, Bindestriche und Leerzeichen aus dem Text entfernt.
dann wird überall, wo ein Wechsel zwischen Ziffer und Text stattfindet, ein Trennzeichen eingefügt, so dass jede vor und nach jedem Zahlenblock ein Trennzeichen steht.
dann wird der Text gesplittet und die Länge der Zählenblöcke bestimmt.
Alles was 8 Ziffern oder mehr in Folge hat, wird als Telefonnummer ausgegeben.

du kannst die Länge, die für die Erkennung als Telefonnummer erforderlich ist, auch in der Formel bestimmen ohne in den Code einzugreifen, in dem du die Mindestlänge als dritten Parameter angibst (ohne Angabe gilt dann der Funktionskopf angegebene Wert):
=Tel($A2;Spalte(A$1);10)

Gruß Daniel

Zahlenfolge (telefonnummern) aus Text auslesen

Forumthread: Zahlenfolge (telefonnummern) aus Text auslesen

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Zahlenfolge (telefonnummern) aus Text auslesen

Forumthread: Zahlenfolge (telefonnummern) aus Text auslesen

16 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread