Regex in VBA/Excel-Umgebung mit assertions
16.06.2017 14:20:46
Stephan
Ich matche mit Hilfe von Regex in Excel/VBA fünfstellige Zahlen (bzw. alternativ ein K gefolgt von vier Zahlen):
.Pattern = "(\d{5}|K\d{4})"
z.B. 12345, 98765, K2345
Das zugehörige Makro durchsucht einen String in Spalte A und schreibt die verschiedenen Ergebnisse in die Spalten B, C, D. Duplikate werden dabei nicht noch einmal gematcht:
.Pattern = "(\d{5}|K\d{4})(?!.*?\1.*$)"
Ich würde nun gerne dafür sorgen, dass nicht solche Zahlen gemacht werden, die Teil einer längeren Zahl sind. Zum Beispiel soll er nicht 12345 aus 123456 Matchen. Allerdings sorgt das Einfügen einer entsprechender lookahead und lookbehind assertions für Fehlermeldungen.
.Pattern = "(?kleinerzeichen!\d)(\d{5}|K\d{4})(?!\d)"
(er lässt mich das Auch gelingt es mir nicht, das oben so gut funktionierende (?!.*?\1.*$) zur Vermeidung von Duplikaten einzubinden.
Beispiele für String-Zeilen in A wären:
2018/ID11298 00000012345 PersoNR: 889899 Bridgestone BNPN
Kompo 32280EP ###Baukasten### 3789936690 ID PFK Carbon0
20613, 20614, Mietop Antragsnummer C300Coup IVS 33221 ABF
Q21009 China lokal produzierte Derivate f/Radverbund 991222 VV
ID:61953 F-Pace Enfantillages (Machine arriere) VvSKPMG Lyon09
2017/22222 21895 22222 Einzelkostenprob. 28932 ZürichMP KOS
ID:K1245 Panamera Nitsche Radlager Derivativ Bayreumion PwC
LaunchSupport QBremsen BBG BFG BBD 70142,70119 KK 70142
Der gesamte Code lautet:
Sub RegEx()
Dim varOut() As Variant
Dim objRegEx As Object
Dim lngColumn As Long
Dim objRegA As Object
Dim varArr As Variant
Dim lngUArr As Long
Dim lngTMP As Long
On Error GoTo Fin
With Worksheets("Sheet1")
varArr = Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
Set objRegEx = CreateObject("VBScript.Regexp")
With objRegEx
.Pattern = "(\d{5}|K\d{4})(?!.*?\1.*$)"
.Global = True
For lngUArr = 1 To UBound(varArr)
Set objRegA = .Execute(varArr(lngUArr, 1))
If objRegA.Count >= lngColumn Then
lngColumn = objRegA.Count
End If
Set objRegA = Nothing
Next lngUArr
If lngColumn = 0 Then Exit Sub
ReDim varOut(1 To UBound(varArr), 1 To lngColumn)
For lngUArr = 1 To UBound(varArr)
Set objRegA = .Execute(varArr(lngUArr, 1))
For lngTMP = 1 To objRegA.Count
varOut(lngUArr, lngTMP) = objRegA(lngTMP - 1)
Next lngTMP
Set objRegA = Nothing
Next lngUArr
End With
.Cells(2, 2).Resize(UBound(varOut), UBound(varOut, 2)) = varOut
End With
Fin:
Set objRegA = Nothing
Set objRegEx = Nothing
If Err.Number 0 Then MsgBox "Error: " & Err.Number & " " & Err.Description
End Sub
Hätte jemand eine Idee?
Vielen Dank!