[求助]EXCEL中怎么用VBA将10进制转换成36进制?

zhcj66

如题<EXCEL中怎么用VBA将10进制转换成36进制?>

这里我知道可以用BASE函数实现 10进制转36进制,但是 我需要按照n的顺序实现,字母在前,数字在后  A最小 9最大;

在百度上看到下面方法,但是报错,VB语言不懂,没接触过,希望知道的帮我看看应该如何修改,这里面需要怎么换行

如单元格 A1内容为 36转换为37进制为AA


用VBA写一个自定义函数，如函数名写为 to36( )

按键ALT+F11，则打开VBA代码编辑器，
菜单中［插入］—［模块］，粘贴以下代码进去。

Function to36(a As Long)
n="ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"

Do
If a < 36 Then n = Mid(n, a + 1, 1) & n: Exit Do
m = a Mod 36
n = Mid(n, m + 1, 1) & n
If a = 36 Then n = 1 & n: Exit Do
a = (a - m) / 36
Loop
End Function

2，在单元格中设置公式，并使用以上的自定义函数，
如在 A1中输入100, B1中设置公式 =to36(A1) , 结果显示为36进制的 2S

linhzye

提示什么出错啊？

linhzye

[Visual Basic] 纯文本查看 复制代码

n = Mid(n, a + 1, 1) & n

这个代码本身就有问题吧，n应该是定义36进制的各个值的表达。这样会把n给修改了

另外你的n的排序有问题啊
一般都是0-9A-Z这样的顺序排列的。你为什么要倒过来？
如果是倒过来，根据你的代码

[Visual Basic] 纯文本查看 复制代码

If a = 36 Then n = 1 & n: 

为什么会在36的十进制会输出36进制的1？
要么根据你的n顺序，要输出9，要么根据正规的36进制输出z。

pbccsgk

首先，100换算成你说的顺序不是2S，而是C2。
你按alt+f11，新建模块，然后再新建的模块里粘贴如下代码即可

Public Function tothirtysix(a As Long) As String
n = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
tothirtysix = ""
Do
    If a < 36 Then tothirtysix = Mid(n, a + 1, 1) & tothirtysix: Exit Do
    m = a Mod 36
    tothirtysix = Mid(n, m + 1, 1) & tothirtysix
    If a = 36 Then tothirtysix = Mid(n, 2, 1) & tothirtysix: Exit Do
    a = (a - m) / 36
Loop

End Function

pbccsgk

pbccsgk 发表于 2022-6-20 17:30
首先，100换算成你说的顺序不是2S，而是C2。
你按alt+f11，新建模块，然后再新建的模块里粘贴如下代码即可 ...

在B1单元格输入=tothirtysix。

benteng302

建议先学习一下VB 的基本语法，，我写了一个可以试一下。

[Visual Basic] 纯文本查看 复制代码

Public Function DoT(iD As Single) '10进制转换换36进制
    On Error GoTo Err_Zone
    Dim iY As Single, iD1 As Single
    Dim sh As String, sH1 As String
    DoT = ""
    Do
        iD1 = iD
        iD1 = Int(iD1 / 36)
        iY = iD - iD1 * 36
        sh = DOTS(iY)
        If iD1 < 36 Then
            sH1 = DOTS(iD1)
            DoT = sH1 & sh & DoT
            Exit Do
        End If
        DoT = sh & DoT
        iD = iD1
    Loop
    Exit Function
Err_Zone:
    MsgBox "数据无效!"
End Function

Private Function DOTS(iDD As Single)
    Select Case iDD
        Case 0 To 9
            DOTS = iDD
        Case 10
            DOTS = "A"
        Case 11
            DOTS = "B"
        Case 12
            DOTS = "C"
        Case 13
            DOTS = "D"
        Case 14
            DOTS = "E"
        Case 15
            DOTS = "F"
        Case 16
            DOTS = "G"
        Case 17
            DOTS = "H"
        Case 18
            DOTS = "I"
        Case 19
            DOTS = "J"
        Case 20
            DOTS = "K"
        Case 21
            DOTS = "L"
        Case 22
            DOTS = "M"
        Case 23
            DOTS = "N"
        Case 24
            DOTS = "O"
        Case 25
            DOTS = "P"
        Case 26
            DOTS = "Q"
        Case 27
            DOTS = "R"
        Case 28
            DOTS = "S"
        Case 29
            DOTS = "T"
        Case 30
            DOTS = "U"
        Case 31
            DOTS = "V"
        Case 32
            DOTS = "W"
        Case 33
            DOTS = "X"
        Case 34
            DOTS = "Y"
        Case 35
            DOTS = "Z"
        Case Else
         
    End Select
End Function

qcz00622

pbccsgk 发表于 2022-6-20 17:30
首先，100换算成你说的顺序不是2S，而是C2。
你按alt+f11，新建模块，然后再新建的模块里粘贴如下代码即可 ...

还是这个VBA代码符合要求，实测都是OK的。注意的是一定要新建模块，在模板里面把代码加进去，才能使用= tothirtysix() 这个函数。

changhong8

[Visual Basic] 纯文本查看 复制代码

Function toNum(x, iStr$) '10进制转N进制，x为待转换数值，iStr为进制文本ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789，有多少位就转成多少进制
Dim n, Res, Arr(), i
n = Len(iStr)
ReDim Arr(n)
For i = 1 To n
    Arr(i - 1) = Mid(iStr, i, 1)
Next
Res = ""
Do While x >= n
    num = x Mod n
    x = (x - num) / n
    Res = Arr(num) & Res
Loop
toNum = Arr(x) & Res
End Function

zhcj66

benteng302 发表于 2022-6-20 17:38
建议先学习一下VB 的基本语法，，我写了一个可以试一下。

[Visual Basic] 纯文本查看 复制代码

Public Function DoT(iD  ...[/indent]
to_10 有bug  用0-5的数随机转换几次就出来bug了


[mw_shl_code=vb,true]Function to_36(a1 As Long, i)
    nn = Application.Rept(0, 99)
    n = "AB0123456789CDEFGHIJKLMNOPQRSTUVWXYZ"
    a = a1
    
    t = ""
    If a < 36 Then
        t = Mid(n, a + 1, 1)
        If Len(t) < i Then
            to_36 = Right(nn & t, i)
        End If
        Exit Function
    End If
    
xx:
    
    m = a Mod 36
    t = Mid(n, m + 1, 1) & t
    s = Int((a - m) / 36)
    If s >= 36 Then
        a = s
        GoTo xx
    Else
        t = Mid(n, s + 1, 1) & t
    End If
    If Len(t) < i Then
        to_36 = Right(nn & t, i)
    Else
        to_36 = t
    End If
        
End Function

'这部分有bug 不知道那里有问题
Function to_10(a1 As String)
    n = "AB0123456789CDEFGHIJKLMNOPQRSTUVWXYZ"
    a = a1
    i = Len(a)
    s = 0
    For x = 1 To i
        If Mid(a, x, 1) <> 0 Then
            a = Mid(a, x, 99)
            Exit For
        End If
    Next
    i = Len(a)
    
    ReDim ar(1 To i)
    For x = 1 To i
        b = InStr(n, Mid(a, x, 1)) - 1
        ar(x) = b
    Next
    
    If i = 1 Then
        to_10 = ar(1)
    ElseIf i = 2 Then
        to_10 = ar(1) * 36 + ar(2)
    ElseIf i = 3 Then
        to_10 = ar(1) * 36 ^ 2 + ar(2) * 36 + ar(3)
    ElseIf i = 4 Then
        to_10 = ar(1) * 36 ^ 3 + ar(2) * 36 ^ 2 + ar(3) * 36 + ar(4)
    ElseIf i = 5 Then
        to_10 = ar(1) * 36 ^ 4 + ar(2) * 36 ^ 3 + ar(3) * 36 ^ 2 + ar(4) * 36 + ar(5)
    ElseIf i = 6 Then
        to_10 = ar(1) * 36 ^ 5 + ar(2) * 36 ^ 4 + ar(3) * 36 ^ 3 + ar(4) * 36 ^ 2 + ar(5) * 36 + ar(6)
    End If
    
End Function