Zahlen aus Text extrahieren

Gepostet am: May 03, 2011 1:30:7 PM

Kürzlich wurde in einem Office Forum die Frage gestellt, wie man aus einem Text die Zahlen extrahiert. Vorgebracht wurden komplizierte Matrix-Funktionen, die nicht zwangsweise das richtige Ergebnis lieferte. Meine Lösung dazu, war die Herangehensweise über Reguläre Ausdrücke:

Zahl aus Text extrahieren

Public Function FindeZahl(myRange As Range, minLaenge As Integer, maxLaenge As Integer, _ Optional iGroup As Integer = 1) As Long   Dim objRegex As Object   Dim objMatch As Object   Set objRegex = CreateObject("VbScript.Regexp")   With objRegex       .Pattern = "\d{" & minLaenge & "," & maxLaenge & "}"       .Global = True       Set objMatch = .Execute(myRange.Value)       FindeZahl = objMatch(iGroup - 1)   End With   Set objMatch = Nothing   Set objRegex = Nothing  End Function

Angenommen man möchte nun jede 9 stellige Zahl aus dem Text extrahieren, verwendet man die Formel folgendermaßen: =FindeZahl(Zellbezug; 9;9)

Wie man aber an nachfolgendem Beispiel sieht, stößt das ganze an Grenzen, wenn die Zahl im Text länger ist als die gesuchte Zahl.

Dafür kann man auch eine Lösung basteln und die oben genannte Funktion erweitern. Der folgende Screenshot aus dem RegexBuddy zeigt, wo das Problem liegt:

Erweitert man den regulären Ausdruck marginal auf "\D(\d{minZeichen;maxZeichen})\D" - also umschossen von NON DIGIT (keine Zahlen), bekommen wir das Ergebnis, das wir wollen. 

Eine entsprechend angepasste Funktion, die zwischen den beiden Methoden umschaltet, würde dann beispielsweise so aussehen: (die ist schon um einiges Länger)

Finde Zahl

Public Function FindeZahl(myRange As Range, minLaenge As Integer, maxLaenge As Integer, _Optional iGroup As Integer = 1, Optional nichtLaenger As Boolean = True) As VariantDim tmpStr As String tmpStr = myRange.Value If IsNumeric(tmpStr) Then     'wenn es nur eine Zahl ist     If nichtLaenger = False Then 'wenn die Zahl auch Länger sein darf         If (Len(tmpStr) >= minLaenge) Then 'dann muss man nur auf die minimale Länge achten             FindeZahl = CLng(Left(tmpStr, maxLaenge))             'gib die ersten Zahlen bis zur maxLaenge zurück         Else 'wenn die Zahl zu kurz ist             FindeZahl = "" 'gib nix zurück         End If     Else 'wenn die Zahl nicht länger sein darf         If (Len(tmpStr) >= minLaenge) And (Len(tmpStr) = maxLaenge) Then         'dann muss die Zahl genau die richtige Länge haben             FindeZahl = CLng(tmpStr)         Else 'sonst             FindeZahl = "" 'gib nix zurück         End If     End If 'ende nichtLaengerElse     'wenn es nicht nur eine Zahl ist, sondern auch Text vorkommt     'dann werden reguläre Ausdrücke angewendet     Dim objRegex As Object     Dim objMatch As Object     Set objRegex = CreateObject("VbScript.Regexp")     With objRegex         If nichtLaenger = False Then 'wenn die Zahl auch länger sein darf             .Pattern = "\d{" & minLaenge & "," & maxLaenge & "}" 'benötigen wir nur die ersten X Nummern             .Global = True             Set objMatch = .Execute(tmpStr)             If objMatch.Count >= 1 Then                 FindeZahl = objMatch(iGroup - 1)             Else 'wenn nichts gefunden wird                 FindeZahl = ""             End If         Else 'wenn die Zahl nicht länger sein darf             .Pattern = "\D(\d{" & minLaenge & "," & maxLaenge & "})\D"             'muss es sich um eine Zahl (\d) umschlossen von Nichtzahlen (\D) handeln             .Global = True             Set objMatch = .Execute(tmpStr)             If objMatch.Count >= 1 Then                 FindeZahl = objMatch(iGroup - 1).SubMatches(0)             Else 'wenn nichts gefunden wird                 FindeZahl = ""             End If         End If     End With     Set objMatch = Nothing     Set objRegex = NothingEnd IfEnd Function

Das liefert genau das Ergebnis, das man haben will

Und zum Abschluss noch die Gegenüberstellung der beidem Methoden