Option Compare Database
Option Explicit
' in a standard module
Private pRegEx As Object
Public Property Get oRegEx() As Object
If (pRegEx Is Nothing) Then Set pRegEx = CreateObject("Vbscript.Regexp")
Set oRegEx = pRegEx
End Property
Public Function RegExReplace(ByVal SourceText As String, _
ByVal SearchPattern As String, _
ByVal ReplaceText As String, _
Optional ByVal bIgnoreCase As Boolean = True, _
Optional ByVal bGlobal As Boolean = True, _
Optional ByVal bMultiLine As Boolean = True) As String
Static RegEx As Object
If RegEx Is Nothing Then
Set RegEx = CreateObject("Vbscript.Regexp")
End If
With RegEx
.Pattern = SearchPattern
.IgnoreCase = bIgnoreCase
.Global = bGlobal
.Multiline = bMultiLine
RegExReplace = .Replace(SourceText, ReplaceText)
End With
End Function
Public Function InnerTrim(ByVal ThisString As String) As String
Dim sResult As String
sResult = ThisString
Do While InStr(1, sResult, " ") > 0
sResult = Replace(sResult, " ", " ")
Loop
InnerTrim = sResult
End Function
Public Function ReplaceMultiSpace(strIN As String) As String
Dim old As String
Dim newout As String
old = Trim(strIN)
newout = old
Do
old = newout
newout = Replace(old, " ", " ")
Loop Until old = newout
ReplaceMultiSpace = newout
End Function
Public Function SngSpaceOnly(ByVal value As Variant)
If IsNull(value) Then
SngSpaceOnly = value
Exit Function
End If
Do While InStr(1, value, " ") <> 0
value = Replace$(value, " ", " ")
Loop
SngSpaceOnly = value
End Function
Public Function OneSpaceOnly(ByVal var As Variant)
Static oReg As Object
Dim s As String
On Error GoTo create_object
If IsNull(var) Then Exit Function
s = var
With oReg
.Pattern = " {2,}"
.Global = True
s = .Replace(s, " ")
End With
OneSpaceOnly = s
Exit Function
create_object:
Set oReg = CreateObject("vbscript.regexp")
Resume Next
End Function
Function SpeedTest(strIN As String)
Dim strOUT As String, dblStart As Double, dblEnd As Double
Dim lngCount As Long
dblStart = Timer
For lngCount = 1 To 10000
strOUT = SngSpaceOnly(strIN)
Next
dblEnd = Timer
Debug.Print "1. SngSpaceOnly" & " : Time Taken = " & dblEnd - dblStart & " s"
dblStart = Timer
For lngCount = 1 To 10000
strOUT = ReplaceMultiSpace(strIN)
Next
dblEnd = Timer
Debug.Print "2. ReplaceMultiSpace" & " : Time Taken = " & dblEnd - dblStart & " s"
dblStart = Timer
For lngCount = 1 To 10000
strOUT = RegExReplace(strIN, " {2,}", " ")
Next
dblEnd = Timer
Debug.Print "3. RegExReplace" & " : Time Taken = " & dblEnd - dblStart & " s"
dblStart = Timer
For lngCount = 1 To 10000
strOUT = OneSpaceOnly(strIN)
Next
dblEnd = Timer
Debug.Print
Debug.Print "Input String to OneSpaceOnly: " & strIN
Debug.Print "Output String from OneSpaceOnly: " & strOUT
Debug.Print
Debug.Print "4. OneSpaceOnly" & " : Time Taken = " & dblEnd - dblStart & " s"
End Function
Sub Test1()
Dim strIN As String
strIN = "abc def ghi xyz"
Debug.Print "Test1 - Short String" & vbCrLf & "===================="
SpeedTest (strIN)
Debug.Print "" & vbCrLf
End Sub
Sub Test2()
Dim strIN As String
strIN = "Regular expressions are a very powerful tool for developers to make use of ." & _
"However, in this particular set of tests, using RegEx was clearly disadvantageous." & _
"Perhaps its use was overkill for the test done?" & _
" " & _
"In other cases, Regex may provide the best or only method of obtaining results." & _
" " & _
"I would be grateful for any feedback on this article" & _
"I would also welcome any suggestions for other tests in order to further assess the comparative" & _
" strength of regular expressions against other methods."
Debug.Print "Test2 - Longer String" & vbCrLf & "======================"
SpeedTest (strIN)
Debug.Print "" & vbCrLf
End Sub
