This is an old revision of the document!
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 [,index]])
Public Function rxMatch( _ ByVal iValue As Variant, _ Optional ByVal iPattern As String = Empty _ ) As Boolean
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
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