[VB/VBA] Code Pattern: RegExp Replace mit Funktion

[VB/VBA] Code Pattern: RegExp Replace mit Funktion

Kurz vornweg. Das ganze habe ich in VBA mit MS Access 2010 und MS Excel 2010 getestet. Sollte aber mMn auch in VB6 und VBS funktioneren.

Naja, der Titel ist ev. irreführend. Mir kam 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
Code:
Bären und Hühner gehören nicht in Ämter
Jetzt will ich alle äöü und ÜÖÜ in Unicode setzen
Code:
B\u00E4ren und H\u00FChner geh\u00F6ren nicht in \u00C4mter

Dazu habe ich mal die Funktion char2unicode() (Anhang B), 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] print_r()
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.
Visual Basic:
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 (Siehe Anhang B)
        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
Visual Basic:
d replUmlaute("Bären und Hühner gehören nicht in Ämter")
<String> '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 cRegExp() (siehe Anhang A). 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
Visual Basic:
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()
Visual Basic:
d replUmlaute("Bären und Hühner gehören nicht in Ämter")
<String> 'B\u00E4ren und H\u00FChner geh\u00F6ren nicht in \u00C4mter'

Beispielsfunktion replUmlauteBack() kompakt
Und natürlich das ganze auch wieder zurückwandeln...
Visual Basic:
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()
Visual Basic:
d replUmlauteBack("B\u00E4ren und H\u00FChner geh\u00F6ren nicht in \u00C4mter")
<String> 'Bären und Hühner gehören nicht in Ämter'

Anhänge
Anhang A: Code cRegExp()

Weitere Details auf www.yaslaw.info: [VBA] cRegExp() Abgespeckte Version
Visual Basic:
/**
' * 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()
Weitere Details auf www.yaslaw.info: [VBA] char2Unicode()
Visual Basic:
'/**
' * Copyright mpl by ERB software | http://wiki.yaslaw.info
' *
' * Wandelt ein Charakter in ein Unicode
' * @example: char2unicode("€") -> '\u20AC'
' * @param  String(1)   Charakter, der gewandelt werden soll
' * @return String      Unicode
' */
Public Function char2unicode(ByVal iChar As String) As String
    char2unicode = Hex(AscW(iChar)) 'Hex-Wert ermitteln
    char2unicode = "\u" & String(4 - Len(char2unicode), "0") & char2unicode
End Function

Anhang C: Code unicode2char()
Weitere Details auf www.yaslaw.info: [VBA] unicode2char()
Visual Basic:
'/**
' * Copyright mpl by ERB software | http://wiki.yaslaw.info
' *
' * Wandelt ein Unicode in ein Charakter
' * @example: unicode2char("\u20AC") -> '\€'
' * @param  String      Unicode
' * @return String      Char
' */
Public Function unicode2Char(ByVal iUnicode As String) As String
    unicode2Char = ChrW(Replace(iUnicode, "\u", "&h"))
End Function
Autor
Yaslaw
Aufrufe
3.072
First release
Last update

Bewertungen

0,00 Stern(e) 0 Bewertungen

More resources from Yaslaw

Share this resource

Zurück