Prüft ob ein Value auf ein Pattern passt. Die RegExp-Objekte werden gecached. Interessant für SQL

Download udf_rxmatch.bas (V-1.0.0)

Manchmalwäre es ganz praktisch in SQL mit Regulären Ausdrücken arbeiten zu können. Dazu habe ich eine Funktionssammlung erstellt, die es mit erlaubt genau dies zu tun. Die RegExp-Objekte werden dabei als statische Objekte gespeichert, damit nicht für jede Zeile ein neues Objekt angelegt werden muss. Es können in einem SL mehrere verschiedene Patterns verwendet werden. Diese kann man mit einem Index ansteuern, damit jeder für sich gespeichert wird.

Boolean = rxMatch(value [,pattern])

Public Function rxMatch( _
        ByVal iValue As Variant, _
        Optional ByVal iPattern As String = Empty _
) As Boolean

• iValue Wert, der geprüft werden soll
• iPattern Reg-Exp-Pattern gemäss cRx(): cRegExp() Beispiele mit Patterns inkl. den Parametern

SELECT t.*
FROM myTable t
WHERE rxMatch(t.username, '/^ruedi$/i');
 
ID | USERNAME
---|---------
7  | Ruedi  
 
 
SELECT t.*
FROM myTable t
WHERE rxMatch(t.username, '/ruedi/i');
 
ID | USERNAME  
---|-----------
4  | Hansruedi 
5  | Hans-Ruedi
7  | Ruedi  
 
 
SELECT t.*,
	rxMatch(t.username, '/ruedi/i') AS like_ruedi,
	rxMatch(t.username, '/ueli/i') AS like_ueli,
	rxMatch(t.username, '/hans/i') AS like_hans,
	rxMatch(t.username, '/hans-?(ueli|peter)/i') AS test4
FROM myTable t;
 
ID | USERNAME   | like_ruedi | like_ueli | like_hans | test4
---|------------|------------|-----------|-----------|------
1  | Hans       | 0          | 0         | -1        | 0    
2  | Hans-Ueli  | 0          | -1        | -1        | -1   
3  | Hansueli   | 0          | -1        | -1        | -1   
4  | Hansruedi  | -1         | 0         | -1        | 0    
5  | Hans-Ruedi | -1         | 0         | -1        | 0    
6  | Ueli       | 0          | -1        | 0         | 0    
7  | Ruedi      | -1         | 0         | 0         | 0    
8  | Peter      | 0          | 0         | 0         | 0    
9  | Hanspeter  | 0          | 0         | -1        | -1   
10 | Hans-Peter | 0          | 0         | -1        | -1   

Result = rxLookup(value [,pattern [,iPosition]])

Public Function rxLookup( _
        ByVal iValue As Variant, _
        Optional ByVal iPattern As String = Empty, _
        Optional ByVal iPosition As Long = 0 _
) As String

• iValue Wert, der geprüft werden soll
• iPattern Reg-Exp-Pattern gemäss cRx(): cRegExp() Beispiele mit Patterns inkl. den Parametern
• iPosition Index des SubMatches des ersten Treffers: rxObject.execute(iPattern)(0).SubMatches(iPosition). Bei -1 wird der geammte Treffer ausgegeben

SELECT t.username, rxLookup(t.username, '/(ruedi)/i', -1) AS Ruedi
FROM myTable t
WHERE rxMatch(t.username, '/(ruedi)/i');
 
username   | Ruedi
-----------|------
Hansruedi  | ruedi
Hans-Ruedi | Ruedi
Ruedi      | Ruedi

Result = rxReplace(value [,pattern [,iPosition]])

Public Function rxReplace( _
        ByVal iValue As Variant, _
        Optional ByVal iPattern As String = Empty, _
        Optional ByVal iReplace As String = Empty _
) As String

• iValue Wert, der geprüft werden soll
• iPattern Reg-Exp-Pattern gemäss cRx(): cRegExp() Beispiele mit Patterns inkl. den Parametern
• iReplace Replace-Value geäss RegExp

SELECT t.username, rxReplace(t.username, '/(hans)([-\s]?)ruedi/i', '$1$2Peter') AS Ruedi
FROM myTable t
WHERE rxMatch(t.username, '/(ruedi)/i');
 
username   | Ruedi     
-----------|-----------
Hansruedi  | HansPeter 
Hans-Ruedi | Hans-Peter
Ruedi      | Ruedi

udf_rxmatch.bas

Attribute VB_Name = "udf_rxMatch"
'-------------------------------------------------------------------------------
'File         : udf_rxMatch.bas
'               Copyright mpl by ERB software
'               All rights reserved
'               wiki.yaslaw.info/dokuwiki/doku.php/vba/functions/rxmatch
'Environment  : VBA 2010 +
'Version      : 1.0.0
'Name         : udf_rxMatch
'Author       : Stefan Erb (ERS)
'History      : 03.10.2016 - ERS - Creation udf_rxMatch
'-------------------------------------------------------------------------------
Option Explicit
 
'/**
' * Prüft ob ein Value auf eon Pattern passt. Die RegExp-Objekte werden gecached.
' * Ist geeignet für die Anwendung in SQL.
' * @param  Variant     Wert, der geprüft werden soll
' * @param  String      Reg-Exp-Pattern gemäss cRx(): http://wiki.yaslaw.info/dokuwiki/doku.php/vba/cast/cregexp#beispiele_mit_patterns_inkl_den_parametern
' * @param  Long        Index. Wenn in einem SQL mehrere rxMatch verwendet werden, kann man diese durchnumerieren
' * @return Boolean
' */
Public Function rxMatch(ByVal iValue As Variant, ByVal iPattern As String, Optional ByVal iIndex As Long = 0) As Boolean
    Static isInitilaize As Boolean
    Static pattern() As String
    Static lastIdx As Long
    Static rx() As Object
 
    If lastIdx < iIndex Or (lastIdx = 0 And iIndex = 0 And isInitilaize = False) Then
        lastIdx = iIndex
        ReDim Preserve pattern(lastIdx): pattern(lastIdx) = iPattern
        ReDim Preserve rx(lastIdx): Set rx(lastIdx) = cRx(iPattern)
        isInitilaize = True
    ElseIf pattern(iIndex) <> iPattern Then
        pattern(iIndex) = iPattern
        Set rx(iIndex) = cRx(iPattern)
    End If
 
    rxMatch = rx(iIndex).test(NZ(iValue))
End Function
 
'-------------------------------------------------------------------------------
' -- Libraries
'-------------------------------------------------------------------------------
 
'/**
' * 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