Text mit Zahl in neue Zelle auslesen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hi Lemmi,
bezogen auf A1:
=WENN(ANZAHL(FINDEN({"Hamburg"."Berlin"."München"."Köln"."Dortmund"};A1));LINKS(TEIL(A1;VERWEIS(99; FINDEN({"Hamburg"."Berlin"."München"."Köln"."Dortmund"};A1));99);FINDEN(" ";TEIL(A1;VERWEIS(99; FINDEN({"Hamburg"."Berlin"."München"."Köln"."Dortmund"};A1));99);FINDEN(" ";TEIL(A1;VERWEIS(99; FINDEN({"Hamburg"."Berlin"."München"."Köln"."Dortmund"};A1));99))+1)-1);"")
Wenn Du dem Array {"Hamburg"."Berlin"."München"."Köln"."Dortmund"} den Namen x gibst, wird´s auch etwas kürzer:
=WENN(ANZAHL(FINDEN(x;A1));LINKS(TEIL(A1;VERWEIS(99;FINDEN(x;A1));99);FINDEN(" ";TEIL(A1;VERWEIS(99; FINDEN(x;A1));99);FINDEN(" ";TEIL(A1;VERWEIS(99;FINDEN(x;A1));99))+1)-1);"")
Grüße Boris

Function NameAndZahl(rZelle As Range) As String Dim Regex As Object, oMatch As Object Set Regex = CreateObject("VBScript.RegExp") With Regex .IgnoreCase = False .MultiLine = True .Pattern = "\w{1,50} \d{1,10}" .Global = True Set oMatch = .Execute(rZelle.Text) End With If oMatch.Count > 0 Then NameAndZahl = oMatch(0).Value End If End Function

Sub Split_Zahl_TXT() Dim meAr, tempText Dim Bereich As Range Dim A As Long Set Bereich = Range("A1", Cells(Rows.Count, 1).End(xlUp).Offset(0, 1)) meAr = Bereich For A = Lbound(meAr) To Ubound(meAr) If InStr(meAr(A, 1), " ") > 0 Then tempText = meAr(A, 1) meAr(A, 1) = Left(meAr(A, 1), InStrRev(meAr(A, 1), " ") - 1) meAr(A, 2) = Right$(tempText, Len(tempText) - InStrRev(tempText, " ")) If IsNumeric(meAr(A, 1)) Then meAr(A, 1) = meAr(A, 1) * 1 End If Next A Bereich = meAr End Sub

Hallo,
In ein Modul

Function NameAndZahl(rZelle As Range, Optional byParameter As Byte = 0) As Variant
Dim Regex As Object, oMatch As Object
'byParameter  0 = alle, 1 = nur Text , 2 = nur Zahl 
Set Regex = CreateObject("VBScript.RegExp")
With Regex
    .IgnoreCase = False
    .MultiLine = True
    .Pattern = "\w{1,50} \d{1,10}"
    .Global = True
     Set oMatch = .Execute(rZelle.Text)


    If oMatch.Count > 0 Then
        If byParameter = 1 Then
            .Pattern = "\d"
            NameAndZahl = Trim(.Replace(oMatch(0).Value, ""))
        ElseIf byParameter = 2 Then
            .Pattern = "\D"
            NameAndZahl = Trim(.Replace(oMatch(0).Value, "")) * 1
        Else
            NameAndZahl = oMatch(0).Value
        End If
    End If

End With
End Function

In der Zelle

	A	B	C	D
1		Alles	Nur Text	Nur Zahl
2	Büro ABC Hamburg 1256 zu Hause	Hamburg 1256	Hamburg	1256
3	Büro Berlin 12345 in Straße XXX	Berlin 12345	Berlin	12345

Formeln der Tabelle

Zelle	Formel
B2	=NameAndZahl(A2)
C2	=NameAndZahl(A2;1)
D2	=NameAndZahl(A2;2)
B3	=NameAndZahl(A3)
C3	=NameAndZahl(A3;1)
D3	=NameAndZahl(A3;2)

Gruß Tino

Function NameAndZahl(rZelle As Range, Optional byParameter As Byte = 0) As Variant Dim Regex As Object, oMatch As Object If Not rZelle.Value Like "*? [0-9]*" Then NameAndZahl = "": Exit Function End If 'byParameter 0 = alle, 1 = nur Text , 2 = nur Zahl Set Regex = CreateObject("VBScript.RegExp") With Regex .IgnoreCase = False .MultiLine = True .Pattern = "[\w|äöüßÄÖÜ]{1,50} \d{1,10}" .Global = True Set oMatch = .Execute(rZelle.Text) If oMatch.Count > 0 Then If byParameter = 1 Then .Pattern = "\d" NameAndZahl = Trim(.Replace(oMatch(0).Value, "")) ElseIf byParameter = 2 Then .Pattern = "\D" NameAndZahl = Trim(.Replace(oMatch(0).Value, "")) * 1 Else NameAndZahl = oMatch(0).Value End If Else NameAndZahl = "" End If End With End Function

Beliebteste Forumthreads (12 Monate)

Text mit Zahl in neue Zelle auslesen

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

397 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Text mit Zahl in neue Zelle auslesen

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

397 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread