Jim Cone said:
I quickly ran three speed tests using Timer on
l00,000 loops on the string provide by Francis..
For five trials the average time was
Function Foo: 0.92 seconds
Function LastPosition: 0.83 seconds
Function RevInStr: 0.65 seconds (using 99 as lngStart)
....
Not my results.
Redirecting the output of the console command
dir c:\ /s/b
to a text file and loading that text file into Excel 2000 without parsing, I
used the first 40,000 filenames and iterated over them 10 times, so 400,000
calls for each function.
Here are my results. For me, foo is much faster than LastPosition.
------------------------------
foo 10.028
foo2 8.022
LastPosition 34.094
RevInStr 6.017
InStrRev 1.003
findrev 1.003
==============================
And here's my testing module.
'---------------------------------------------------------------------
Sub testem()
Const MAXITER As Long = 10, NUMROWS As Long = 40000
Dim r As Range
Dim s() As String, p() As Long
Dim i As Long, j As Long
Dim dt As Date, et As Date
On Error GoTo ExitProc
Application.Calculation = xlCalculationManual
Set r = ActiveSheet.Range("A1").Resize(NUMROWS, 1)
ReDim s(1 To NUMROWS)
ReDim p(1 To NUMROWS, 1 To 1)
For i = 1 To NUMROWS
s(i) = r.Cells(i, 1).Value
Next i
Debug.Print String(30, "-")
dt = Now
For i = 1 To MAXITER
For j = 1 To NUMROWS
p(j, 1) = foo(s(j), "\")
Next j
Next i
et = Now - dt
Debug.Print Format(et * 86640#, """foo ""0.000")
r.Offset(0, 2).Value = p
Erase p
ReDim p(1 To NUMROWS, 1 To 1)
dt = Now
For i = 1 To MAXITER
For j = 1 To NUMROWS
p(j, 1) = foo2(s(j), "\")
Next j
Next i
et = Now - dt
Debug.Print Format(et * 86640#, """foo2 "" 0.000")
r.Offset(0, 4).Value = p
Erase p
ReDim p(1 To NUMROWS, 1 To 1)
dt = Now
For i = 1 To MAXITER
For j = 1 To NUMROWS
p(j, 1) = LastPosition(s(j), "\")
Next j
Next i
et = Now - dt
Debug.Print Format(et * 86640#, """LastPosition ""0.000")
r.Offset(0, 6).Value = p
Erase p
ReDim p(1 To NUMROWS, 1 To 1)
dt = Now
For i = 1 To MAXITER
For j = 1 To NUMROWS
p(j, 1) = RevInStr(s(j), "\", 0)
Next j
Next i
et = Now - dt
Debug.Print Format(et * 86640#, """RevInStr "" 0.000")
r.Offset(0, 8).Value = p
Erase p
ReDim p(1 To NUMROWS, 1 To 1)
dt = Now
For i = 1 To MAXITER
For j = 1 To NUMROWS
p(j, 1) = InStrRev(s(j), "\")
Next j
Next i
et = Now - dt
Debug.Print Format(et * 86640#, """InStrRev "" 0.000")
r.Offset(0, 10).Value = p
Erase p
ReDim p(1 To NUMROWS, 1 To 1)
dt = Now
For i = 1 To MAXITER
For j = 1 To NUMROWS
p(j, 1) = findrev("\", s(j))
Next j
Next i
et = Now - dt
Debug.Print Format(et * 86640#, """findrev "" 0.000")
r.Offset(0, 12).Value = p
Debug.Print String(30, "=")
ExitProc:
Application.Calculation = xlCalculationAutomatic
Application.Calculate
End Sub
Function foo(s As String, ss As String) As Long
Dim k As Long, n As Long
k = Len(ss)
n = InStr(1, s, ss)
If n > 0 Then
foo = Len(s) - k
Do
foo = foo - 1
Loop Until Mid(s, foo, k) = ss Or foo <= n
Else
foo = n
End If
End Function
Function foo2(s As String, ss As String) As Long
Dim k As Long, n As Long, p As Long
k = Len(ss)
n = Len(s) - k + 1
For p = n To 0 Step -1
If p > 0 Then If Mid(s, p, k) = ss Then Exit For
Next p
foo2 = p
End Function
Function LastPosition( _
ByRef strInput As String, _
ByRef strChars As String _
) As Long
'Jim Cone - San Francisco - Sep 18, 2003
'ByVal allows variants to be used for the string variables
On Error GoTo WrongPosition
Dim lngPos As Long
Dim lngCnt As Long
Dim lngLength As Long
lngPos = 1
lngLength = Len(strChars)
Do
lngPos = InStr(lngPos, strInput, strChars, vbTextCompare)
If lngPos Then
lngCnt = lngPos
lngPos = lngPos + lngLength
End If
Loop While lngPos > 0
LastPosition = lngCnt
Exit Function
WrongPosition:
Beep
LastPosition = 0
End Function
'----------------------------------------------------------------
' Searches for a character, but starting at the end of the string.
' strString is the string you want to search in
' strChar is the character or string of characters you want to search for
' lngStart is the position in TheString you want to start the search at.
'----------------------------------------------------------------
Function RevInStr( _
ByRef strString As String, _
ByRef strChar As String, _
ByVal lngStart As Long _
) As Long
Dim lngNdx As Long
Dim lngLength As Long
lngLength = Len(strChar)
'If strChar length > 1 this reduces number of loops required
If lngStart <= 0 Or lngStart > Len(strString) Then _
lngStart = Len(strString) - lngLength + 1
For lngNdx = lngStart To 1 Step -1
If Mid$(strString, lngNdx, lngLength) = strChar Then
RevInStr = lngNdx - 1
'or (lngNdx + lngLength) depending on which section
'you want
Exit For
End If
Next 'lngNdx
' In case nothing found or In case position found was 1 which
' would return 0.
If RevInStr = 0 Then RevInStr = 1
End Function
Function findrev(ss As String, s As String) As Long
findrev = InStrRev(s, ss)
End Function
'---------------------------------------------------------------------
Your RevInStr returns 1 less than all the other functions. I haven't
explored what might be needed to have it return the same values when there
are matches and 0 when there aren't. Returning 1 for both no match at all
and the only match at the beginning of strString is bad programming.
However, given the times for direct InStrRev and findrev, a simple wrapper
around InStrRev, I'll strengthen with my original statement to this: anyone
with VBA6 would a fool not to use VBA6's InStrRev.
