Nummer vierstellig extrahieren

Mike · 2017-09-15T08:41:07+00:00

Guten Morgen, gerne würde ich aus einem (leider nicht 100% genormten) Textstring jeweils eine vierstellige Nummer auslesen. In vielen Fällen würde dies mit =rechts() gut funktionieren, jedoch eben nicht in allen. Kd-Auftrags-Nr.: 7893 Kd-Auftrags-Nr. 4500 Auftrag 5673 Auftrag 8111 des Kunden Auftrag 7'444 Auftrag 1432_ Wie kann generell eine vierstellige Nummer erkannt werden, ob nun am Schluss oder im Text? Die Schwierigkeit ist wohl zusätzlich die allfällige Tausendertrennung. Besten Dank für Eure Hilfe, Gruss Mike

Hallo Mike
am schnellsten und einfachsten geht das über ein Makro, da brauchst du nicht mit Formeln rumtricksen.
Den unteren Code in ein Modul eingeben, über Button oder Makro Dialog starten, das ist alles. Bitte noch anpassen!
Ich habe zum testen Spalte A genommen und das Ergebnis in Spalte B geschrieben. Sollten dein Text in einer anderen Spalte stehen musst du alle "A"s gegen eine andere Spalte austauschen. Das ist alles.
mfg Piet

Sub Makro1()
Dim AC As Range, lz As Long
Sheets("Tabelle1").Select
'LastZell in Spalte "A" ermitteln
lz = Cells(Rows.Count, "A").End(xlUp).Row
'Schleife für Bereich in der Text steht
For Each AC In Range("A3:A" & lz)
'Zahl am Ende oder in Mitte suchen
If IsNumeric(Trim(Right(AC, 5))) Then
AC.Offset(0, 1) = Trim(Right(AC, 5))
Else
'Schleife für Text in Mitte
For j = 1 To Len(AC)
If IsNumeric(Mid(AC, j, 1)) Then
AC.Offset(0, 1) = Trim(Mid(AC, j, 5))
Exit For
End If
Next j
End If
'Tausender Zeichen löschen
AC.Offset(0, 2).Replace " ", ""
AC.Offset(0, 2).Replace "'", ""
AC.Offset(0, 2).Replace "_", ""
Next AC
End Sub

Hallo Mike,
und noch eins oder zwei mehr:

Private Sub ziffern_extrahieren()
Dim ze As Long, zeichen As String
For ze = 1 To Cells(Rows.Count, 1).End(xlUp).Row '"1 to..." wenn Du in Zeile 1 anfängst
For zeichen = 1 To Len(Cells(ze, 1))
If IsNumeric(Mid(Cells(ze, 1), zeichen, 1)) Then
Cells(ze, 2) = (Cells(ze, 2) & Mid(Cells(ze, 1), zeichen, 1)) * 1
End If
Next
Next
End Sub

Natürlich könntest Du auch mit regulären Ausdrücken arbeiten.
Wäre bei größeren Datenmengen bestimmt au8ch schneller:


Public Function regExIt(strgInput As String, strgPattern As String) As String
Dim objRegExp As Object, objMatch As Object, objItem As Object
Set objRegExp = CreateObject("Vbscript.regexp")
objRegExp.Pattern = strgPattern
objRegExp.Global = True
Set objMatch = objRegExp.Execute(strgInput)
For Each objItem In objMatch
regExIt = regExIt & objItem.Value
Next objItem
Set objRegExp = Nothing
Set objMatch = Nothing
Set objItem = Nothing
End Function
Sub getNumbersonly()
Dim i As Long
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
Cells(i, 2) = regExIt(Cells(i, 1), "[0-9]+")
Next
End Sub

Gruß
Jochen

Forumthread: Nummer vierstellig extrahieren

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Nummer vierstellig extrahieren

Forumthread: Nummer vierstellig extrahieren

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread