====== [VBA][Code Pattern] RegExp Replace mit Funktion ======
//Ein Tutorial zum Thema, wie man eine %%RegExp Replace%% in einer Schleife anwenden kann.//
Naja, der Titel ist ev. irreführend. Mir kahm aber kein besserer in den Sinn. Es geht um folgendes: Mittels eines %%RegExp%% ermittle ich Teilstrings. Diese sollen über eine Funktion verändert werden und dann im String den Originalteilstring ersetzen.
===== Beispielsaufgabe =====
Ein kleines Beispiel: den folgende String
Bären und Hühner gehören nicht in Ämter
Jetzt will ich alle äöü und ÜÖÜ in Unicode setzen
B\u00E4ren und H\u00FChner geh\u00F6ren nicht in \u00C4mter
Dazu habe ich mal die Funktion [[vba:cast:char2unicode]], welche mir einen einzelnen Char nach Unicode wandelt.
===== Umsetzungen =====
Mit %%RegExp.replace()%% kann ich bekanntlich keine User-Funktion ausführen. Darum löse ich das meistens wie folgt.
> Für die Ausgabe der Resultate verwendete ich die Funktion [[vba:functions:print_r:index]]
==== Konzept ====
Ich erstelle ein %%RegExp%%-Objekt, das genau nur ein Treffer zurückgibt (global=off). Mit einer Schleife teste ich auf den String, ob %%RegExp%% noch einen Treffer hat.
Jeder Treffer wird ausgelesen. Mittels einer UDF (User Defined Function) kann man mit dem gefundenen String oder Submatches etwas machen
Anschliessend nutze ich der %%RegExp%%.replace() um den Teilstring im Original durch den Neuen zu ersetzen
Das ganez wiederholen bis keine Treffer mehr da sind
==== Einschränkung ====
Es funktioniert natürlich nicht, wenn der neue String wieder dem Pattern entspricht. Wenn ich also bei %%IgnoreCase%% ''A'' durch ''a'' ersetzen will, landet das ganze in einer Endlosschleife.
==== Version 1) Funktion mit detailiertem Aufbau ====
=== Beispielsfunktion replUmlaute() mit detailiertem Aufbau ===
Die folgende Umsetzung beinhaltet eigentlich bereits die ganze Logik. Zum besseren Verständnis sind noch alle Schritte einzel auugeführt. Die Erklärung ist im Code mit drin.
Public Function replUmlaute(ByVal iString As String) As String
'Das RegExp als Statisch definieren, damit es nicht bei jedem Aufruf initialisiert werden muss
Static rx As regExp
Dim mc As MatchCollection
Dim m As match
Dim sm As subMatches
Dim unicode As String
If rx Is Nothing Then
Set rx = New regExp
rx.pattern = "([äöü])"
rx.IgnoreCase = True
'Die folgende Zeile müsste ich eigentlich nicht setzen.
'Aber es ist Wichtig, dass Global nicht auf True ist.
rx.Global = False
End If
replUmlaute = iString
'Den folgenden Code-Abschnitt ausführen, bis keine Umlaute mehr vorkommen
Do While rx.Test(replUmlaute)
'Der erste Treffer wird zurückgegeben
Set mc = rx.execute(replUmlaute)
'Wegen global=Off hat die MatchCollection genau einen Match auf der Position 0
Set m = mc(0)
'Und einen Submatch auf der Position 0
Set sm = m.subMatches
'Den Buchstaben in Unicode wandeln
unicode = char2unicode(sm(0))
'und den ersten Treffer mittels RegExp ersetzen
'Dank global=off gibts nur den einen Treffer zu ersetzen
replUmlaute = rx.Replace(replUmlaute, unicode)
Loop
End Function
=== Test der Funktion ===
d replUmlaute("Bären und Hühner gehören nicht in Ämter")
'B\u00E4ren und H\u00FChner geh\u00F6ren nicht in \u00C4mter'
==== Version 2) Kompakte Version ====
In dieser Version verzichte ich darauf, alle Schritte einzeln durchzugehen. Auch das ertellen des %%RegExp%% überlasse ich der Funktion [[vba:cast:cregexp#abgespeckte_version_crx|[VBA] cRegExp() Abgespeckte Version]]. Dann sieht der Code noch so aus.
Ja, der erste ist besser lesbar. Wenn an aber ein Pattern immer wieder verwendet, erkennt man es beim lesen vom Code sofort.
=== Beispielsfunktion replUmlaute() kompakt ===
Public Function replUmlaute(ByVal iString As String) As String
Static rx As Object: If rx Is Nothing Then Set rx = cRegExp("/([äöü])/i")
replUmlaute = iString
Do While rx.Test(replUmlaute)
replUmlaute = rx.Replace(replUmlaute, char2unicode(rx.execute(replUmlaute)(0).subMatches(0)))
Loop
End Function
=== Test der Funktion replUmlaute() ===
d replUmlaute("Bären und Hühner gehören nicht in Ämter")
'B\u00E4ren und H\u00FChner geh\u00F6ren nicht in \u00C4mter'
=== Beispielsfunktion replUmlauteBack() kompakt ===
Und natürlich das ganze auch wieder zurückwandeln...
Public Function replUmlauteBack(ByVal iString As String) As String
Static rx As Object: If rx Is Nothing Then Set rx = cRegExp("/(\\u[\dA-F]{4})/i")
replUmlauteBack = iString
Do While rx.Test(replUmlauteBack)
replUmlauteBack = rx.Replace(replUmlauteBack, unicode2Char(rx.execute(replUmlauteBack)(0).subMatches(0)))
Loop
End Function
=== Test der Funktion replUmlauteBack() ===
d replUmlauteBack("B\u00E4ren und H\u00FChner geh\u00F6ren nicht in \u00C4mter")
'Bären und Hühner gehören nicht in Ämter'
===== Beipiele in Action =====
In den [[vba:cast:json]] setze ich dieses Pattern mehrfach ein.
===== Anhänge =====
==== Anhang A: Code cRegExp() ====
'/**
' * Erstellt ein RegExp-Object mit den Grundeinstellungen
' * V2.0.1
' * @param String Pattern mit Delmiter und igm-Parametern
' * @return RegExp
' */
Private Function cRegExp(ByVal iPattern As String) As Object
Static rxP As Object 'RegExpo um iPattern aufzubrechen
If rxP Is Nothing Then
Set rxP = CreateObject("VBScript.RegExp")
rxP.pattern = "^([@&!/~#=\|])(.*)\1(?:([Ii])|([Gg])|([Mm]))*$"
End If
Set cRegExp = CreateObject("VBScript.RegExp") 'Neuer RegExp erstellen
If Not rxP.Test(iPattern) Then cRegExp.pattern = iPattern: Exit Function 'Falls es ein einfacher Pattern ist, diesen übernehmen und die Func verlassen
Dim parts As Object: Set parts = rxP.execute(iPattern)(0).subMatches 'Pattern zerlegen. 0) Delemiter, 1) Pattern, 2) - 4) Paramters
cRegExp.IgnoreCase = Not isEmpty(parts(2))
cRegExp.Global = Not isEmpty(parts(3))
cRegExp.Multiline = Not isEmpty(parts(4))
cRegExp.pattern = parts(1)
End Function
==== Anhang B: Code char2unicode() ====