VBA generate a code

eberg

there. I made this code that replaces a character for two number (e.g. 0 = 10; 1 = 11; 2 = 12; ...) and everything works fine except for the first element (the zero element). So, if I put "010a4" string on cell A1 and use my formula "=GENERATECODE(A1)", my expected return value is "1011102014" but I've got a "110111102014" string. So, only zero value occur this error and I can't figured out why. Any thoughts?

My code:

    Function GENERATECODE(Code As String)
    Dim A As String
    Dim B As String
    Dim i As Integer
    Const AccChars = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
    Const RegChars = "1011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071"
    For i = 1 To Len(AccChars)
        A = Mid(AccChars, i, 1)
        B = Mid(RegChars, 2 * i - 1, 2)
        Code = Replace(Code, A, B)
    Next
    GENERATECODE = Code
End Function
John Coleman

In addition to being incorrect, your current code is inefficient since it involves scanning over the code string multiple times instead of just once. Simply scan over the string once, gathering the substitutions into an array which is joined at the end:

Function GENERATECODE(Code As String) As String
    Dim codes As Variant
    Dim i As Long, n As Long
    Dim c As String
    n = Len(Code)
    ReDim codes(1 To n)
    For i = 1 To n
        c = Mid(Code, i, 1)
        Select Case c
            Case "0" To "9":
                codes(i) = "1" & c
            Case "a" To "z":
                codes(i) = Asc(c) - 77
            Case "A" To "Z":
                codes(i) = Asc(c) - 19
            Case Else:
                codes(i) = "??"
        End Select
    Next i
    GENERATECODE = Join(codes, "")
End Function

Example:

?generatecode("010a4")
1011102014

The point of the two offsets is that you want "a" to map to 20 and "A" to map to 46. Note Asc("a") - 77 = 97 - 77 and Asc("A") - 19 = 65-19 = 46.

Collected from the Internet

Please contact [email protected] to delete if infringement.

edited at
0

Comments

0 comments
Login to comment

Related