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)

Boolean = rxMatch(value [,pattern [,index]])

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

• iValue Wert, der geprüft werden soll
• iPattern Reg-Exp-Pattern gemäss cRx(): cRegExp() Beispiele mit Patterns inkl. den Parametern
• iIndex Index. Wenn in einem SQL mehrere rxMatch/rsLookup verwendet werden, kann man diese durchnumerieren

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', 0) AS like_ruedi,
	rxMatch(t.username, '/ueli/i', 1) AS like_ueli,
	rxMatch(t.username, '/hans/i', 2) AS like_hans,
	rxMatch(t.username, '/hans-?(ueli|peter)/i', 3) 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   

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