Replacement for VB6′s Replace$ function (fastest way)
Posted on January 4, 2009
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 | 'String Manipulation - Replacement for VB6's Replace$ function (fastest way) Option Explicit 'This function is 3 to 4 times faster than VB6 built-in Replace function. Public Function Replace(ByVal strExpression As String, sFind As String, sReplace As String, _ Optional lStart As Long = 1, Optional lCount As Long, _ Optional ByVal lCompare As VbCompareMethod = vbBinaryCompare) As String Dim lSize As Long, lHit As Long, lHitPos As Long, lPos As Long, lLenOld As Long, lLenNew As Long Dim lLenOrig As Long, lOffset As Long, lOffStart As Long, lCnt As Long, al() As Long Dim s1 As String, s2 As String lLenOrig = Len(strExpression) If (lLenOrig = 0) Then Exit Function lLenOld = Len(sFind) lLenNew = Len(sReplace) Replace = strExpression If (lLenOld = 0) Then Exit Function If lCompare = vbBinaryCompare Then s1 = sFind s2 = strExpression Else s1 = LCase$(sFind) s2 = LCase$(strExpression) End If lOffset = lLenNew - lLenOld lCnt = 0 lSize = 8000 ReDim al(0 To lSize) As Long lHit = InStr(lStart, s2, s1) Do While (lHit <> 0) And (lHit <= lLenOrig) al(lCnt) = lHit lCnt = lCnt + 1 If (lCnt = lCount) Then Exit Do If (lCnt = lSize) Then lSize = lSize + 8000 ReDim Preserve al(0 To lSize) As Long End If lOffStart = lHit + lLenOld lHit = InStr(lOffStart, s2, s1) Loop If (lCnt = 0) Then GoTo FreakOut lCount = lCnt If lCompare = vbBinaryCompare Then If StrComp(s1, sReplace) = 0 Then Exit Function End If lSize = (lLenOrig + lOffset * lCnt) Replace = Space$(lSize) lCnt = lCnt - 1 lOffStart = 1 lPos = 1 For lHit = 0 To lCnt lHitPos = al(lHit) Mid$(Replace, lOffStart) = Mid$(strExpression, lPos, lHitPos - lPos) lOffStart = lHitPos + (lOffset * lHit) If (lLenNew <> 0) Then Mid$(Replace, lOffStart) = sReplace lOffStart = lOffStart + lLenNew End If lPos = lHitPos + lLenOld Next lHit If lOffStart <= lSize Then Mid$(Replace, lOffStart) = Mid$(strExpression, lPos) End If End Function |