Schnelles erstellen eines RegExp-Obektes mit erweiterten Pattern (Patterns erweitert um die Settings von RegExp).

Diese Funktion erstellt aus einem Pattern direkt ein RegExp-Objekt. Das erspart im Code immer ein Mehrzeiler zu generieren um ein RegExp-Objekt mit allen Settings zu bekommen.
Zudem kann man für einfache Anwendungen direkt damit weiterarbeiten ohne das Objekt in eine Variable zu schreiben

Download cast_cregexp.bas (V-2.1.0)

RegExp = cRegExp(pattern [,flags])
RegExp = cRegExp(pattern inkl. flags)

Public Function cRegExp( _
        ByVal iPattern As String, _
        Optional ByVal iFlag As rxpFlagsEnum = rxnone _
) As Object

• iPattern Ein normaler Regulärer Ausdruck oder einer in der PHP-Schreibweise mit Delemiter und Modifiers
• iFlag Kombination der Flags(analog den Modifiers) um das RegExp zu steuern.

'/**
' * Wird für die rx_ Funktionen verwendet
' * Setzte die Flags für das RegExp Object
' */
Public Enum rxFlagsEnum
    rxnone = 2 ^ 0          'Value 1
    rxglobal = 2 ^ 1        'Value 2
    rxIgnorCase = 2 ^ 2     'Value 4
    rxMultiline = 2 ^ 3     'Value 8
End Enum

Setzte die Flags für das RegExp Object. Für das genaue Verhalten bitte die VB-Doku zur RegExp Klasse studieren

• rxNone Alle Parameter werden auf False gesetzt. Wird vor allem zum überschreiben des Standards gebraucht.
• rxGlobal Setzt Global¹⁾ auf True
• rxIgnorCase Setzt IgnorCase²⁾ auf True
• rxMultiline Setzt Multiline auf True

Die Suchstrings können als Reguläre Ausdrücke daherkommen. Dazu müssen sie wie in PHP für preg_match() mittels Delemiter und Modifiers formatiert werden.

[Delemiter][Regulärer Ausdruck][Delemiter][Modifiers]

Als Delemiter können die folgenden Zeichen verwendet werden

@&!/~#=|

Es gibt 3 Modifier.Genau soviele wie die RegExp-Klasse Properties hat. Die Grosskleinschreibung wird nicht berücksichtig. Ebensowenig die Reihenfolge.

• i IgnoreCase
• g Global
• m Multiline

Für die Ausgabe der Resultate verwendete ich die Funktion [VBA] print_r().

In den folgenden Beispielen wird als erstes Argument der Nackte Pattern mitgegeben und als 2te die Parameter

'Ohne weitere Paramters
d cRegExp("ABC ([a-k]*)")
<IRegExp2>  (
    [Pattern] => <String> 'ABC ([a-k]*)'
    [Global] => <Boolean> False
    [IgnoreCase] => <Boolean> False
    [Multiline] => <Boolean> False
)
 
'Mit IgnoreCase
d cRegExp("ABC ([a-k]*)", rxpIgnorCase)
<IRegExp2>  (
    [Pattern] => <String> 'ABC ([a-k]*)'
    [Global] => <Boolean> False
    [IgnoreCase] => <Boolean> True
    [Multiline] => <Boolean> False
)
 
'Mit IgnoreCase und Multiline
d cRegExp("ABC ([a-k]*)", rxpIgnorCase + rxpMultiline)
<IRegExp2>  (
    [Pattern] => <String> 'ABC ([a-k]*)'
    [Global] => <Boolean> False
    [IgnoreCase] => <Boolean> True
    [Multiline] => <Boolean> True
)

'Ohne Parameters und / als Delemiter
d cRegExp("/ABC ([a-k]*)/")
<IRegExp2>  (
    [Pattern] => <String> 'ABC ([a-k]*)'
    [Global] => <Boolean> False
    [IgnoreCase] => <Boolean> False
    [Multiline] => <Boolean> False
)
 
'Mit IgnoreCase und @ asl Delemiter
d cRegExp("@ABC ([a-k]*)@i")
<IRegExp2>  (
    [Pattern] => <String> 'ABC ([a-k]*)'
    [Global] => <Boolean> False
    [IgnoreCase] => <Boolean> True
    [Multiline] => <Boolean> False
)
 
'IgnoreCase und Multiline und ! als Delemiter. Im Pattern selber kommt auch ein ! vor, wird korrekterweise nicht als Delemiter erkannt
d cRegExp("!ABC! ([a-k]*)!im")
<IRegExp2>  (
    [Pattern] => <String> 'ABC! ([a-k]*)'
    [Global] => <Boolean> False
    [IgnoreCase] => <Boolean> True
    [Multiline] => <Boolean> True
)

Diese 'Alles in einem String'-Art macht so natürlich wenig Sinn. Aber in gewissen Funktionen kann es durchaus lukrativ sein. So habe ich cRegExp() erfolgreich in die Funktion [VBA] strReplace() eingebaut. Dort wäre es nicht möglich mit den erweiterten Parametern zu arbeiten.

'Ersetze alle test.com-Domainen durch gmail.com und alle gmail.com durch test.com. 
'Dabei soll die Grosskleinschreibweise ignoriert werden
d strReplace("test@Test.com,hans@test.com,jonas@gmail.com", "/([\w_\.-]+)@test.com/i", "$1@gmail.com", "/([\w_\.-]+)@gmail.com/i", "$1@test.com")
<String> 'test@gmail.com,hans@gmail.com,jonas@test.com'

Public Sub testCRegExp()
    Dim mc As Object: Set mc = cRegExp("\(([^\)]+)\)", rxpGlobal).execute("(123)(456)")
    Dim m As Object: For Each m In mc
        Debug.Print m.value
    Next m
End Sub

Download cast_cregexp.bas (V-2.1.0)

cast_cregexp.bas

Attribute VB_Name = "cast_cRegExp"
'-------------------------------------------------------------------------------
'File         : cast_cRegExp.bas
'               Copyright mpl by ERB software
'               All rights reserved
'               http://wiki.yaslaw.info/dokuwiki/doku.php/vba
'Environment  : VBA 2010 +
'Version      : 2.1.0
'Name         : cRegExp
'Author       : Stefan Erb (ERS)
'History      : 19.06.2014 - ERS - Creation cls_regExp
'               04.09.2014 - ERS - Pattern mit Modifiers ergänzt. Umbennent zu cast_cregexp
'               31.10.2014 - ERS - Cache auf Static geändert
'               01.12.2014 - ERS - cRx hinzugefügt
'-------------------------------------------------------------------------------
Option Explicit
 
' /**
' * Wird für die regExp Funktionen verwendet
' * Setzte die Flags für das RegExp Object
' */
Public Enum rxpFlagsEnum
    rxpnone = 2 ^ 0          'Value 1
    rxpGlobal = 2 ^ 1        'Value 2   Modifier g Global
    rxpIgnorCase = 2 ^ 2     'Value 4   Modifier i IgnoreCase
    rxpMultiline = 2 ^ 3     'Value 8   Modifier m multiLine
End Enum
 
'/**
' * Erstellt ein RegExp-Object mit den Grundeinstellungen
 
' * @param  String          Pattern analog RegExp oder mit Delimiter und Modifier analog zu PHP
' * @param  rxpFlagsEnum    Eigenschaften von Regexp. Global, IgnoreCase und Multiline.
' *                         Die Eigenschaften können mit + kombiniert werden
' * @return RegExp
' */
Public Function cRegExp( _
        ByVal iPattern As String, _
        Optional ByVal iFlag As rxpFlagsEnum = rxNone _
) As Object
    Static rxPattern As Object
    If rxPattern Is Nothing Then
        Set rxPattern = CreateObject("VBScript.RegExp")
        rxPattern.pattern = "^([@&!/~#=\|])?(.*)\1(?:([Ii])|([Gg])|([Mm]))*$"
    End If
    Set cRegExp = CreateObject("VBScript.RegExp")
    If rxPattern.Test(iPattern) Then
        Dim sm As Object: Set sm = rxPattern.Execute(iPattern)(0).subMatches
        cRegExp.pattern = sm(1)
        cRegExp.IgnoreCase = Not isEmpty(sm(2))
        cRegExp.Global = Not isEmpty(sm(3))
        cRegExp.Multiline = Not isEmpty(sm(4))
    Else
        cRegExp.pattern = iPattern
        cRegExp.Global = iFlag And rxpGlobal
        cRegExp.IgnoreCase = iFlag And rxpIgnorCase
        cRegExp.Multiline = iFlag And rxpMultiline
    End If
End Function
 
'------------------------------------------------------
' Kurzversion um in andere Funktionen einzubinden
'------------------------------------------------------
' Die folgende Version cRx() verwende ich als Library in anderen Funktion.
' Sie entspricht der Version mit den Modifier im String.
 
'/**
' * Dies ist die Minimalversion von cRegExp
' * http://wiki.yaslaw.info/dokuwiki/doku.php/vba/cast/cregexp#abgespeckte_version
' * mögliche Delemiter: @&!/~#=\|
' * mögliche Modifiers: g (Global), i (IgnoreCode, m (Mulitline)
' *
' * @example    myRx = cRx("/([a]{2,})/i") 'Finde alle folgen von a. Flag:IgnoreCase
' * @version    2.1.0 (01.12.2014)
' * @param      String      Pattern mit Delimiter und Modifier analog zu PHP
' * @return     Object      RegExp-Object
' */
Private Function cRx(ByVal iPattern As String) As Object
    Static rxP As Object:       Set cRx = CreateObject("VBScript.RegExp")
    If rxP Is Nothing Then:     Set rxP = CreateObject("VBScript.RegExp"): rxP.pattern = "^([@&!/~#=\|])?(.*)\1(?:([Ii])|([Gg])|([Mm]))*$"
    Dim sm As Object:           Set sm = rxP.Execute(iPattern)(0).subMatches
    cRx.pattern = sm(1):        cRx.IgnoreCase = Not isEmpty(sm(2)):       cRx.Global = Not isEmpty(sm(3)):     cRx.Multiline = Not isEmpty(sm(4))
End Function
 

Häufig kopiere ich die folgenden Zeilen als Library in ein Modul oder Klasse um sie Selbständig zu machen. Siehe auch sinnvolle anwendung.
Die folgende Version ist analog zu vielen JQuery-Scripten die min-Version. Sprich, es ist dasseleb wie die Haubtversion, jedoch so kompakt dass es nicht mehr einfach lesbar ist. Dafür bläht es den Code nicht so stark auf, wenn man die Funktion in ein weiteres Modul packt.

'/**
' * Dies ist die Minimalversion von cRegExp
' * http://wiki.yaslaw.info/dokuwiki/doku.php/vba/cast/cregexp#abgespeckte_version
' * mögliche Delemiter: @&!/~#=\|
' * mögliche Modifiers: g (Global), i (IgnoreCode, m (Mulitline)
' *
' * @example    myRx = cRx("/([a]{2,})/i") 'Finde alle folgen von a. Flag:IgnoreCase
' * @version    2.1.0 (01.12.2014)
' * @param      String      Pattern mit Delimiter und Modifier analog zu PHP
' * @return     Object      RegExp-Object
' */
Private Function cRx(ByVal iPattern As String) As Object
    Static rxP As Object:       Set cRx = CreateObject("VBScript.RegExp")
    If rxP Is Nothing Then:     Set rxP = CreateObject("VBScript.RegExp"): rxP.pattern = "^([@&!/~#=\|])?(.*)\1(?:([Ii])|([Gg])|([Mm]))*$"
    Dim sm As Object:           Set sm = rxP.Execute(iPattern)(0).subMatches
    cRx.pattern = sm(1):        cRx.IgnoreCase = Not isEmpty(sm(2)):       cRx.Global = Not isEmpty(sm(3)):     cRx.Multiline = Not isEmpty(sm(4))
End Function