Page 1 of 2 12 LastLast
Results 1 to 15 of 28
  1. #1
    Join Date
    Jan 2006
    Posts
    28

    Unanswered: Puzzle: replicating the REPLACE function

    Hi,

    This is more like a puzzle question but, any ideas on how to mimic REPLACE without actually using it? Like maybe using a bunch of IIF and INSTR and MID functions? Can't use VB.

    Thanks!
    Last edited by opelcorsa; 08-10-10 at 19:34.

  2. #2
    Join Date
    Feb 2004
    Location
    One Flump in One Place
    Posts
    14,912
    Yes it is possible. In fact I believe vbscript does not have a REPLACE function so you have to roll one up yourself for that - the logic is the same as you would use.

    If it is a puzzle (just for the hell of it) then why not have a stab and post what you come up with on here.
    Testimonial:
    pootle flump
    ur codings are working excelent.

  3. #3
    Join Date
    Mar 2009
    Posts
    5,442
    Provided Answers: 14
    Several solutions were published. One of the most interesting (brilliant even!) is this one:
    Code:
    Function VBReplace(sString As String, sTerm As String, sNewTerm As String, Optional lStart As Long = 1, Optional lHitCnt As Long, _
                       Optional ByVal eCompare As VbCompareMethod = vbBinaryCompare) As String
    '
    ' This function is similar to the standard Replace function but 10 times faster.
    '
        Dim lLenOld As Long
        Dim lLenNew As Long
        Dim lCnt As Long
        Dim lLenStr As Long
        Dim lOffset As Long
        Dim lHit As Long
        Dim lOffStart As Long
        Dim lHitPos As Long
        Dim lPos As Long
        Dim alHits() As Long
        Dim lSize As Long
        Dim lProg As Long
        Dim sTermL As String
        Dim sStrL As String
    
        On Error GoTo FreakOut
        If lStart < 1 Then lPos = 1 Else lPos = lStart + lStart - 1 ' Determine start position
        lStart = 0
        lLenStr = LenB(sString)
        If (lLenStr = 0) Then Exit Function  ' Nothing to process
        lLenOld = LenB(sTerm)
        If (lLenOld = 0) Then GoTo ShortCirc ' Nothing to process
        lLenNew = LenB(sNewTerm)
        lOffset = lLenNew - lLenOld
        lSize = 500 '
        ReDim alHits(0 To lSize) As Long
        If (eCompare = vbTextCompare) Then
        
            ' Convert once to lowercase rather than on every call to InStr
            '
            sTermL = LCase$(sTerm): sStrL = LCase$(sString)
            lHit = InStrB(lPos, sStrL, sTermL, vbBinaryCompare)
        Else
        
            ' Do first search
            '
            lHit = InStrB(lPos, sString, sTerm, vbBinaryCompare)
        End If
        Do While (lHit)              ' Do until no more hits
            If (lHit And 1&) Then
                lOffStart = lLenOld
                alHits(lCnt) = lHit
                lCnt = lCnt + 1
                If (lCnt = lHitCnt) Then Exit Do
                If (lCnt = lSize) Then
                    lSize = lSize + 5000
                    ReDim Preserve alHits(0 To lSize) As Long
                End If
            Else
                lOffStart = 1
            End If
            If (eCompare = vbTextCompare) Then
                lHit = InStrB(lHit + lOffStart, sStrL, sTermL)
            Else
                lHit = InStrB(lHit + lOffStart, sString, sTerm)
            End If
        Loop
        lHitCnt = lCnt
        If (lCnt = 0) Then GoTo ShortCirc   ' No hits
        lSize = lLenStr + (lOffset * lCnt)  ' lSize = result chr count
        If (lSize = 0) Then Exit Function   ' Result is an empty string
        VBReplace = Space$(lSize * 0.5)     ' Pre-allocate memory
        lOffStart = 1: lPos = 1
        If (lLenNew) Then
           For lHit = 0 To lCnt - 1
               lHitPos = alHits(lHit)
               lProg = lHitPos - lPos
               If (lProg) Then              ' Build new string
                   MidB$(VBReplace, lOffStart) = MidB$(sString, lPos, lProg)
                   lOffStart = lOffStart + lProg
               End If
               MidB$(VBReplace, lOffStart) = sNewTerm
               lOffStart = lOffStart + lLenNew
               lPos = lHitPos + lLenOld     ' No offset orig str
           Next
        Else
           For lHit = 0 To lCnt - 1
               lHitPos = alHits(lHit)
               lProg = lHitPos - lPos       ' Build new string
               If (lProg) Then
                   MidB$(VBReplace, lOffStart) = MidB$(sString, lPos, lProg)
                   lOffStart = lOffStart + lProg
               End If
               lPos = lHitPos + lLenOld     ' No offset orig str
           Next
        End If
        If lOffStart <= lSize Then MidB$(VBReplace, lOffStart) = MidB$(sString, lPos)
        lStart = (lOffStart + 1 - lLenNew) * 0.5    ' Last hit pos in returned string
        
    FreakOut:
        Exit Function
        
    ShortCirc:  ' If nothing to do
        VBReplace = sString
        
    End Function
    I think I found it somewhere on Karl E. Peterson's Classic VB Code but I'm not sure of it. My apologies to the author if I'm not giving credit to the right person.
    Have a nice day!

  4. #4
    Join Date
    Feb 2004
    Location
    One Flump in One Place
    Posts
    14,912
    Jesus Christ - that looks verbose.
    Ok so there's a couple of extra parameters there but **** me. Is it all really necessary?

    Anyhoo - it does make me realise one thing - a SQL version would be more difficult than I initially thought. Replacing the first instance is easy. Replacing N instances is harder. Still possible I think but much harder.
    Testimonial:
    pootle flump
    ur codings are working excelent.

  5. #5
    Join Date
    Nov 2004
    Location
    out on a limb
    Posts
    13,692
    Provided Answers: 59
    Quote Originally Posted by Sinndho View Post
    Several solutions were published. One of the most interesting (brilliant even!) is this one:
    Code:
    Function VBReplace(sString As String, sTerm As String, sNewTerm As String, Optional lStart As Long = 1, Optional lHitCnt As Long, _
                       Optional ByVal eCompare As VbCompareMethod = vbBinaryCompare) As String
    '
    ' This function is similar to the standard Replace function but 10 times faster.
    '
        Dim lLenOld As Long
        Dim lLenNew As Long
        Dim lCnt As Long
        Dim lLenStr As Long
        Dim lOffset As Long
        Dim lHit As Long
        Dim lOffStart As Long
        Dim lHitPos As Long
        Dim lPos As Long
        Dim alHits() As Long
        Dim lSize As Long
        Dim lProg As Long
        Dim sTermL As String
        Dim sStrL As String
    
        On Error GoTo FreakOut
        If lStart < 1 Then lPos = 1 Else lPos = lStart + lStart - 1 ' Determine start position
        lStart = 0
        lLenStr = LenB(sString)
        If (lLenStr = 0) Then Exit Function  ' Nothing to process
        lLenOld = LenB(sTerm)
        If (lLenOld = 0) Then GoTo ShortCirc ' Nothing to process
        lLenNew = LenB(sNewTerm)
        lOffset = lLenNew - lLenOld
        lSize = 500 '
        ReDim alHits(0 To lSize) As Long
        If (eCompare = vbTextCompare) Then
        
            ' Convert once to lowercase rather than on every call to InStr
            '
            sTermL = LCase$(sTerm): sStrL = LCase$(sString)
            lHit = InStrB(lPos, sStrL, sTermL, vbBinaryCompare)
        Else
        
            ' Do first search
            '
            lHit = InStrB(lPos, sString, sTerm, vbBinaryCompare)
        End If
        Do While (lHit)              ' Do until no more hits
            If (lHit And 1&) Then
                lOffStart = lLenOld
                alHits(lCnt) = lHit
                lCnt = lCnt + 1
                If (lCnt = lHitCnt) Then Exit Do
                If (lCnt = lSize) Then
                    lSize = lSize + 5000
                    ReDim Preserve alHits(0 To lSize) As Long
                End If
            Else
                lOffStart = 1
            End If
            If (eCompare = vbTextCompare) Then
                lHit = InStrB(lHit + lOffStart, sStrL, sTermL)
            Else
                lHit = InStrB(lHit + lOffStart, sString, sTerm)
            End If
        Loop
        lHitCnt = lCnt
        If (lCnt = 0) Then GoTo ShortCirc   ' No hits
        lSize = lLenStr + (lOffset * lCnt)  ' lSize = result chr count
        If (lSize = 0) Then Exit Function   ' Result is an empty string
        VBReplace = Space$(lSize * 0.5)     ' Pre-allocate memory
        lOffStart = 1: lPos = 1
        If (lLenNew) Then
           For lHit = 0 To lCnt - 1
               lHitPos = alHits(lHit)
               lProg = lHitPos - lPos
               If (lProg) Then              ' Build new string
                   MidB$(VBReplace, lOffStart) = MidB$(sString, lPos, lProg)
                   lOffStart = lOffStart + lProg
               End If
               MidB$(VBReplace, lOffStart) = sNewTerm
               lOffStart = lOffStart + lLenNew
               lPos = lHitPos + lLenOld     ' No offset orig str
           Next
        Else
           For lHit = 0 To lCnt - 1
               lHitPos = alHits(lHit)
               lProg = lHitPos - lPos       ' Build new string
               If (lProg) Then
                   MidB$(VBReplace, lOffStart) = MidB$(sString, lPos, lProg)
                   lOffStart = lOffStart + lProg
               End If
               lPos = lHitPos + lLenOld     ' No offset orig str
           Next
        End If
        If lOffStart <= lSize Then MidB$(VBReplace, lOffStart) = MidB$(sString, lPos)
        lStart = (lOffStart + 1 - lLenNew) * 0.5    ' Last hit pos in returned string
        
    FreakOut:
        Exit Function
        
    ShortCirc:  ' If nothing to do
        VBReplace = sString
        
    End Function
    I think I found it somewhere on Karl E. Peterson's Classic VB Code but I'm not sure of it. My apologies to the author if I'm not giving credit to the right person.
    great answer, except that the OP specifically says he can't use VB
    I'd rather be riding on the Tiger 800 or the Norton

  6. #6
    Join Date
    Jan 2006
    Posts
    28
    Thanks all but I can't use VB in this particular case. I have come up with this but it's pretty limited:

    Code:
    IIf(x > 0, IIf(xx > x, IIf(xxx > xx, IIf(xxxx > xxx, yyyyy, yyyy), yyy), yy), y)
     
    where 
    x: InStr(1, FIELD, Chr(34))
    xx: InStr(InStr(1, FIELD, Chr(34))+1, FIELD, Chr(34))
    xxx: InStr(InStr(InStr(1, FIELD, Chr(34))+1, FIELD, Chr(34))+1, FIELD, Chr(34))
    xxxx: InStr(InStr(InStr(InStr(1, FIELD, Chr(34))+1, FIELD, Chr(34))+1, FIELD, Chr(34))+1, FIELD, Chr(34))
    
    y: FIELD
    yy: LEFT(FIELD, x-1) & "''" & RIGHT(FIELD, LEN(FIELD)-x)
    yyy: LEFT(FIELD, x-1) & "''" & MID(FIELD, x+1, xx-x-1) & "''" & RIGHT(FIELD, LEN(FIELD)-xx)
    yyyy: LEFT(FIELD, x-1) & "''" & MID(FIELD, x+1, xx-x-1) & "''" & MID(FIELD, xx+1, xxx-xx-1) & "''" & RIGHT(FIELD, LEN(FIELD)-xxx)
    yyyyy: LEFT(FIELD, x-1) & "''" & MID(FIELD, x+1, xx-x-1) & "''" & MID(FIELD, xx+1, xxx-xx-1) & "''" & MID(FIELD, xxx+1, xxxx-xxx-1) & "''" & RIGHT(FIELD, LEN(FIELD)-xxxx)
    The above is supposed to mimic REPLACE(FIELD, Chr(34), "''") and it can handle up to only 4 recursions. Of course I could keep going to increase the recursions but that's still not ideal. If I had a for-loop or something things would've been easier!
    Last edited by opelcorsa; 08-11-10 at 19:59.

  7. #7
    Join Date
    Nov 2004
    Location
    out on a limb
    Posts
    13,692
    Provided Answers: 59
    it seems a little far fetched this
    after all Left(myvar,NoCahrs) is VB/VBA
    as is Right, CHR$, and so on.

    IIF is JET SQL
    I'd rather be riding on the Tiger 800 or the Norton

  8. #8
    Join Date
    Jan 2006
    Posts
    28
    The reason for this thread is mainly because I want the script to work in Access and Jet.

    I have used this logic to create my SQL statement and it seems to be working, although, the script size is about 30,000 characters lol I'm doing a 6-level deep recursion.

  9. #9
    Join Date
    Nov 2004
    Location
    out on a limb
    Posts
    13,692
    Provided Answers: 59
    ?
    so either use standard SQL or use JET SQL
    virtually all functions in VBA are also available in JET SQL
    so you can use replace in the SQL
    ..admittedly I've only tried this in the Acces query browser I haven't tried this in VB or VB.NET, but in principle I don't see why it can't work.

    do we assume that you are using Access and not another application language such as VB, Delphi or whatever?
    I'd rather be riding on the Tiger 800 or the Norton

  10. #10
    Join Date
    Jan 2006
    Posts
    28
    My requirement is this: the queries need to run in Access and in Jet. I'm not using SQL. And I can't use VB or any other language.

  11. #11
    Join Date
    Mar 2009
    Posts
    5,442
    Provided Answers: 14
    Quote Originally Posted by opelcorsa View Post
    My requirement is this: the queries need to run in Access and in Jet. I'm not using SQL. And I can't use VB or any other language.
    If you don't use SQL, nor VB or any other language, how do you expect to find a solution?

    For those who are interested in faster alternatives to VB native functions (in this case the Replace() function), have a look at:
    VBspeed: Replace
    Have a nice day!

  12. #12
    Join Date
    Jan 2006
    Posts
    28
    Quote Originally Posted by Sinndho View Post
    If you don't use SQL, nor VB or any other language, how do you expect to find a solution?

    For those who are interested in faster alternatives to VB native functions (in this case the Replace() function), have a look at:
    VBspeed: Replace
    Well, that's the whole point of this thread! It's always possible that I have overlooked something in Access/Jet and someone else could tell me about it. But from the looks of it the solution that I posted earlier is the best I can do with these requirements.

  13. #13
    Join Date
    Mar 2009
    Posts
    5,442
    Provided Answers: 14
    As stated before by healdem, your "solution" is using both VBA and Jet SQL.
    Have a nice day!

  14. #14
    Join Date
    Jan 2006
    Posts
    28
    I don't understand what you guys are talking about -sorry! I meant that my half-arse solution is working in Access and Jet -and that's all I cared about. I don't know which function is for VBA and which is for Jet. When I said I can't use VB I meant that I can't write new functions in VB and have them called by Access queries.

  15. #15
    Join Date
    Mar 2009
    Posts
    5,442
    Provided Answers: 14
    What difference do you make between using Replace (a native VB function) and using (Left(), Right(), Mid(), Chr(), Len(), etc. (also native VB functions) ?

    And how is your solution written? An Access Query is written in Jet SQL SQL and, in your case, uses VBA functions.

    I think that is why nobody clearly understands what you mean. I sure don't.
    Have a nice day!

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •