Excel-VBA-Collection

1
Attribute VB_Name = "Base36"
2
Option Explicit
3
Option Compare Text
4
Option Base 1
5
DefLng A-Z
6

7
Public Function To36(Value As Variant) As String
8
    Dim n As Long, v As Long
9
    
10
    On Error GoTo ErrHandler
11
    If Value < 10 Then '0..9
12
        To36 = Chr(48 + Value) '"0"+x
13
    ElseIf Value < 36 Then 'A..Z
14
        To36 = Chr(55 + Value) '"A"-10+x
15
    Else 'If Value < 2147483648# Then
16
        To36 = vbNullString
17
        n = CCur(Value)
18
        Do While n > 0
19
            v = n Mod 36
20
            If v < 10 Then v = v + 48 Else v = v + 55
21
            To36 = Chr(v) & To36
22
            n = n \ 36
23
        Loop
24
    End If
25
    Exit Function
26
    
27
ErrHandler:
28
    To36 = "-1" 'Overflow!
29
End Function
30

31
Public Function Ot36(Value As String) As Long
32
    Dim i, n, v, b() As Byte
33
    
34
    'On Error GoTo ErrHandler
35
    n = Len(Value)
36
    If n = 1 Then '1 digit only
37
        Ot36 = Asc(Value)
38
        Select Case Ot36
39
            Case 48 To 57 '0..9
40
                Ot36 = Ot36 - 48
41
            Case 65 To 90 'A..Z
42
                Ot36 = Ot36 - 55
43
            Case 97 To 122 'a..z
44
                Ot36 = Ot36 - 87
45
            Case Else
46
                GoTo ErrHandler
47
        End Select
48
    Else
49
        StrToBytes b, Value
50
        Ot36 = 0
51
        For i = 1 To n
52
            v = b(i)
53
            Select Case v
54
                Case 48 To 57 '0..9
55
                    v = v - 48
56
                Case 65 To 90 'A..Z
57
                    v = v - 55
58
                Case 97 To 122 'a..z
59
                    v = v - 87
60
                Case Else
61
                    GoTo ErrHandler
62
            End Select
63
            Ot36 = Ot36 + v * (36 ^ (n - i))
64
        Next
65
    End If
66
    Exit Function
67

68
ErrHandler:
69
    Ot36 = -1 'Overflow!
70
End Function
71