MultiInStr (Update Nov 7, 2009)
This is an improvement on the MultiInStr function that appears in other peoples code now and again ... I don't know who the original author was, so I hope who-ever you are you don't mind ... The original code would search through a string looking for occurences of single characters, while this pair of functions search for single-or-multi character terms within the given string ... Included are MultiInStr and MultiInStrR functions ... Hope someone finds them useful ... Update 25 May - improved versions added thanks to contributions from Kenneth Buckmaster ... Update 7 Nov - Reset string len bug fix in Ken's MultiInStr ... Happy coding
Rate MultiInStr (Update Nov 7, 2009)
(4(4 Vote))
'---------------------------------
' Simple MultiInStr:
' Always returns 'their' before 'heir'
' but returns either 'the' or 'their' depending on
' which term was found first in sTerms array order
Function MultiInStr(sSrc As String, sTerms() As String, _
Optional ByVal lStart As Long = 1, _
Optional ByVal eCompare As VbCompareMethod = vbBinaryCompare, _
Optional ByVal lRightLimit As Long = -1, _
Optional ByRef lHitItemIndex As Long) As Long
Dim iPos As Long
Dim iHit As Long
Dim iIdx As Long
If lRightLimit = -1 Then lRightLimit = Len(sSrc)
iHit = Len(sSrc) + 1
For iIdx = LBound(sTerms) To UBound(sTerms)
iPos = InStr(lStart, sSrc, sTerms(iIdx), eCompare)
If iPos Then
If iPos < iHit Then iHit = iPos: lHitItemIndex = iIdx
End If
Next
If iHit < Len(sSrc) + 1 Then MultiInStr = iHit
End Function
'---------------------------------
' Comment From: Kenneth Buckmaster
' It occurred to me that you could avoid searching the
' whole string length after a term is found
' Also added something you might want in these functions -
' returns 'the' before 'their' when in the same location
Private Declare Sub CopyMemory Lib
"kernel32" Alias "RtlMoveMemory" _
(pDest
As Any, pSrc As Any, ByVal lLenB As Long)
Function MultiInStr(sSrc As String, sTerms() As String, _
Optional ByVal lStart As Long = 1, _
Optional ByVal eCompare As VbCompareMethod = vbBinaryCompare, _
Optional ByVal lRightLimit As Long = -1, _
Optional ByRef lHitItemIndex As Long) As Long ' Kenneth Buckmaster
Dim iPos As Long
Dim iHit As Long
Dim iIdx As Long
Dim spointer As Long
Dim slenb As Long
Dim biggestlen As Long
Dim newsearchlen As Long
Dim bHit As Boolean
slenb = LenB(sSrc)
spointer = StrPtr(sSrc) - 4&
For iIdx = LBound(sTerms) To UBound(sTerms)
If LenB(sTerms(iIdx)) > biggestlen Then biggestlen = LenB(sTerms(iIdx))
Next
If lRightLimit = -1 Then lRightLimit = Len(sSrc)
iHit = Len(sSrc) + 1
For iIdx = LBound(sTerms) To UBound(sTerms)
iPos = InStr(lStart, sSrc, sTerms(iIdx), eCompare)
If iPos Then
If iPos < iHit Then
bHit = True
ElseIf iPos = iHit Then
bHit = LenB(sTerms(iIdx)) < LenB(sTerms(lHitItemIndex))
End If
If bHit Then
iHit = iPos
lHitItemIndex = iIdx
newsearchlen = iHit + iHit + biggestlen
If newsearchlen < slenb Then
CopyMemory ByVal spointer, newsearchlen, 4&
End If
bHit = False
End If
End If
Next
CopyMemory ByVal spointer, slenb, 4&
If iHit < Len(sSrc) + 1 Then MultiInStr = iHit
End Function
'---------------------------------
' Simple MultiInStrR:
' Returns 'heir' before 'their' for reverse search
' but returns either 'the' or 'their' depending on
' which term was found first in sTerms array order
Function MultiInStrR(sSrc As String, sTerms() As String, _
Optional ByVal lRightStart As Long = -1, _
Optional ByVal eCompare As VbCompareMethod = vbBinaryCompare, _
Optional ByVal lLeftLimit As Long = 1, _
Optional ByRef lHitItemIndex As Long) As Long
Dim iLast As Long
Dim iPos As Long
Dim iHit As Long
Dim iIdx As Long
If lRightStart = -1 Then lRightStart = Len(sSrc)
For iIdx = LBound(sTerms) To UBound(sTerms)
iPos = InStr(lLeftLimit, sSrc, sTerms(iIdx), eCompare)
Do Until iPos = 0 Or iPos > lRightStart
iLast = iPos
iPos = InStr(iLast + 1, sSrc, sTerms(iIdx), eCompare)
Loop
If iLast > iHit Then
iHit = iLast
lHitItemIndex = iIdx
lLeftLimit = iLast
iLast = 0
End If
Next
If iHit Then MultiInStrR = iHit
End Function
'---------------------------------
' Comment From: Kenneth Buckmaster
' Always returns 'heir' before 'their' for reverse search
' Always returns 'their' before 'the' for reverse search
Function MultiInStrR(sSrc As String, sTerms() As String, _
Optional ByVal lRightStart As Long = -1, _
Optional ByVal eCompare As VbCompareMethod = vbBinaryCompare, _
Optional ByVal lLeftLimit As Long = 1, _
Optional ByRef lHitItemIndex As Long) As Long ' Kenneth Buckmaster
Dim iLast As Long
Dim iPos As Long
Dim iHit As Long
Dim iIdx As Long
Dim bHit As Boolean
If lRightStart = -1 Then lRightStart = Len(sSrc)
For iIdx = LBound(sTerms) To UBound(sTerms)
iPos = InStr(lLeftLimit, sSrc, sTerms(iIdx), eCompare)
Do Until iPos = 0 Or iPos > lRightStart
iLast = iPos
iPos = InStr(iLast + 1, sSrc, sTerms(iIdx), eCompare)
Loop
If iLast > iHit Then
bHit = True
ElseIf iLast = iHit Then
bHit = LenB(sTerms(iIdx)) > LenB(sTerms(lHitItemIndex))
End If
If bHit Then
iHit = iLast
lHitItemIndex = iIdx
lLeftLimit = iLast
iLast = 0
bHit = False
End If
Next
If iHit Then MultiInStrR = iHit
End Function
MultiInStr (Update Nov 7, 2009) Comments
No comments yet — be the first to post one!
Post a Comment