[53期国庆附加题] 玩转 N 进制 -----------已结

ldy

VBA只提供了 8  和16进制转换函数，Oct 和 Hex，这是两种在各个领域使用比较多的进制。
到底可以有多少进制？理论上能够找到多少不同字符，就可以有多少进制。
如果用汉字作为进制的表示字符，搞出1000 进制2000进制也不是问题。
这种特殊进制有什么用？别的作用不知道，但最起码起到了数字加密的作用。
FF 这是一个16进制数， 10进制就是255，这对经常和程序打交道的人来说没有秘密，
但对于不懂的人来说这就是天书。
如果借助汉字编写一个188进制的转换函数，对某个数字进行转换后的结果是：
中华人民共和国万岁
是不是很酷?
如果不知道是188进制，也不知道是采用的是哪188个汉字，根本不可能知道这个数字是什么。
题目  2分
编写两个函数，
1.转换Long 值（-2147483648  到 2147483647）为N进制字符串
2.转换N进制字符串 为 Long值（-2147483648  到 2147483647）
要求：纯VBA代码，不得使用API， 不得引用外部对象。常数 Jzs 不得修改。
为使代码简洁、易读，假定传入的参数都是正确合理的，即不会出现 N2ChrX(40000,37) 、
ChrX2N("FFFF",2) 此类参数错误。代码中不需要使用 On Error 语句。
数字0 和 字母 O 看起来很像的问题不用考虑。

评分标准：结果正确、代码效率达到要求，一个函数 1 分

1. 
   
2. Function N2ChrX(ByVal L As Long, ByVal N As Integer) As String
   
3.     '作用：将Long值转换为 N 进制所表示的字符串
   
4.     '参数说明 L 要转换的值, N (2-36) 将要使用的进制数
   
5.     Const Jzs As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
   
6. 
   
7. End Function
   
8. Function ChrX2N(ByVal S As String, ByVal N As Integer) As Long
   
9.     '作用：字符串值转换为 N 进制所表示的字符串
   
10.     '参数说明 S 要转换的N进制字符串, N (2-36) 对S变量进制数的说明
    
11.     Const Jzs As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    
12.     S = UCase(S)
    
13.    
    
14. End Function
    
15. '结果正确与否请自行验证，代码效率可用下面代码测试。
    
16. Sub 效率验证N2ChrX()
    
17.     Dim L As Long, i As Long, v As Long, t As Double, t2 As Double
    
18.     t = Timer
    
19.     v = 65535
    
20.     For i = 1 To 1000000
    
21.         S = Hex(v)
    
22.     Next
    
23.     t = Timer - t
    
24.     t2 = Timer
    
25.         For i = 1 To (i - 1) / 10
    
26.         S = N2ChrX(v, 16)
    
27.     Next
    
28.     t2 = Timer - t2
    
29.     Index = t2 / t * 10 '(越小越好，我的参考指数平均为 15-20 )
    
30. MsgBox "代码效率指数为 " & Index & IIf(Index < 100, "   不错！如结果正确可得分", "   太慢了不得分")
    
31. End Sub
    
32. Sub 效率验证ChrX2N()
    
33.     Dim L As Long, i As Long, v As Long, t As Double, t2 As Double
    
34.     t = Timer
    
35.     v = 65535
    
36.     For i = 1 To 1000000
    
37.          S = Hex(v)
    
38.     Next
    
39.     t = Timer - t
    
40.     t2 = Timer
    
41.     For i = 1 To (i - 1) / 10
    
42.         L = ChrX2N("FFFF", 16)
    
43.     Next
    
44.     t2 = Timer - t2
    
45.     Index = t2 / t * 10 '(越小越好，我的参考指数平均为 20-25 )
    
46. MsgBox "代码效率指数为 " & Index & IIf(Index < 100, "   不错！如结果正确可得分", "   太慢了不得分")
    
47. End Sub
    
48. 
    
49. Sub 自检()
    
50.     Dim L As Long, L2 As Long, I As Integer, Boo As Boolean, S As String, Lrr(-1000 To 1002) As Long
    
51.     V = 65535
    
52.     t = Timer
    
53.     For L = 1 To 74000
    
54.         S = Hex(V)
    
55.     Next
    
56.     t = Timer - t
    
57. 
    
58.     Boo = True
    
59.     For L = -1000 To 1000
    
60.         Lrr(L) = L
    
61.     Next
    
62.     Lrr(1001) = -2147483648#
    
63.     Lrr(1002) =  2147483647
    
64. 
    
65.     t1 = Timer
    
66.     For L = -1000 To 1002
    
67.         For I = 2 To 36
    
68.             L2 = ChrX2N(N2ChrX(Lrr(L), I), I)
    
69.             Boo = (Lrr(L) = L2) And Boo
    
70.             'If Boo = False Then Stop
    
71.         Next
    
72.     Next
    
73. 
    
74.     For L = -1000 To 1002
    
75.         L2 = ChrX2N(Hex(Lrr(L)), 16)
    
76.         Boo = (Lrr(L) = L2) And Boo
    
77.         'If Boo = False Then Stop
    
78.     Next
    
79.     For L = -1000 To 1002
    
80.         L2 = ChrX2N(Oct(Lrr(L)), 8)
    
81.         Boo = (Lrr(L) = L2) And Boo
    
82.         'If Boo = False Then Stop
    
83.     Next
    
84.     t1 = Timer - t1
    
85.     Index = t1 / t
    
86. Debug.Print "效率指数：" & Index; "   200之内 可以结受"
    
87.     If Boo Then
    
88.         MsgBox "自检成功，有机会得分，具体还要看实际结果， 效率指数：" & Index
    
89.     Else
    
90.         MsgBox "自检有错误,不得分" & "  效率指数：" & Index
    
91.     End If
    
92. End Sub
    

复制代码

答题后 请运行 自检 程序

答题者请跟帖占位，跟帖中不要出现与题目相关的内容，否则不予评分。
截止日期 2009-10-20 以发邮件时间为准。
答案请按如下格式发送到邮箱 26258103@163.com （不需要附件，纯文字即可）
邮件主题： VBA53期国庆附加题答案
邮件内容：

1. 
   
2. 'ID :  xxxxxxxxxxxxxxxx
   
3. Function N2ChrX(ByVal L As Long, ByVal N As Integer) As String
   
4.     '作用：将Long值转换为 N 进制所表示的字符串
   
5.     '参数说明 L 要转换的值, N (2-36) 将要使用的进制数
   
6.     Const Jzs As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
   
7. 
   
8. End Function
   
9. Function ChrX2N(ByVal S As String, ByVal N As Integer) As Long
   
10.     '作用：字符串值转换为 N 进制所表示的字符串
    
11.     '参数说明 S 要转换的N进制字符串, N (2-36) 对S变量进制数的说明
    
12.     Const Jzs As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    
13.     S = UCase(S)
    
14.    
    
15. End Function
    
16. 
    
17. 
    
18. 
    
19. 
    

复制代码

参考答案：

1. 
   
2. 'ID ： LDY
   
3. Function N2ChrX(ByVal L As Long, N As Integer) As String
   
4.     Const Jzs As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
   
5.     Dim v As Double, x As Double, y As Long
   
6.     If N = 10 Then N2ChrX = L: Exit Function' 10进制转10进制没必要处理，直接赋值
   
7.     v = L - (L < 0) * 4294967296#  '把负数转为 正数 赋值给 Double
   
8.     Do
   
9.         N2ChrX = Mid(Jzs, v - Int(v / N) * N + 1, 1) & N2ChrX
   
10.         v = Int(v / N)
    
11.     Loop While v > 0
    
12. End Function
    
13. 
    
14. Function ChrX2N(ByVal S As String, N As Integer) As Long
    
15.     Const Jzs As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    
16.     Dim i%, v As Double
    
17.     S = UCase(S)
    
18.     If N = 10 Then ChrX2N = S: Exit Function
    
19.     For i = 1 To Len(S)
    
20.         v = v + (InStr(Jzs, Mid$(S, i, 1)) - 1) * N ^ (Len(S) - i)
    
21.     Next
    
22.     ChrX2N = v + (v > 2147483647) * 4294967296#   
    
23. End Function
    

复制代码

结贴 http://club.excelhome.net/viewthread.php?tid=484032&page=4#pid3244334

[ 本帖最后由 ldy 于 2009-10-22 15:13 编辑 ]

HHAAMM

邮件已发送，请查收，多谢！！

俺用的方法不好

1. 
   
2. '论坛ID：HHAAMM    OK + 2
   
3. Function N2ChrX(ByVal L As Long, ByVal N As Integer) As String
   
4.     '作用：将Long值转换为 N 进制所表示的字符串
   
5.     '参数说明 L 要转换的值, N (2-36) 将要使用的进制数
   
6.     Const Jzs As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
   
7.     Dim m As Double, i%, j%, p$, b As Double, LL As Double
   
8.     Dim a(100) As Double
   
9.     LL = L
   
10.     If LL < 0 Then
    
11.         Dim x1 As Double, i1 As Integer, t%
    
12.         Dim bb(31) As Integer
    
13.         x1 = Abs(LL / 2)
    
14.         dInt = Abs(Int(x1))
    
15.         t1 = 31
    
16.         If InStr(x1, ".") Then bb(t1) = 1 Else bb(t1) = 0
    
17.         Do While dInt > 0
    
18.             t1 = t1 - 1
    
19.             x1 = dInt / 2
    
20.             dInt = Int(x1)
    
21.             If InStr(x1, ".") Then bb(t1) = 1 Else bb(t1) = 0
    
22.         Loop
    
23.         bb(0) = 1
    
24.         For i1 = 1 To 31
    
25.             If bb(i1) = 1 Then bb(i1) = 0 Else bb(i1) = 1
    
26.         Next
    
27.         For i1 = 31 To 1 Step -1
    
28.             If bb(i1) = 1 Then bb(i1) = 0 Else bb(i1) = 1: Exit For
    
29.         Next
    
30.         x1 = 0
    
31.         For i1 = 31 To 0 Step -1
    
32.             x1 = x1 + bb(i1) * 2 ^ (31 - i1)
    
33.         Next
    
34.         LL = x1
    
35.     End If
    
36.     i = 100
    
37.     Do
    
38.         b = Int(LL / (N - 0.00000000001))
    
39.         If LL >= N Then
    
40.             a(i) = (LL - b * N)
    
41.         Else
    
42.             a(i) = LL
    
43.             Exit Do
    
44.         End If
    
45.         LL = b
    
46.         i = i - 1
    
47.     Loop
    
48.    
    
49.     For i = 0 To 100
    
50.         If a(i) > 0 Then Exit For
    
51.     Next
    
52.     For j = i To 100
    
53.         p = Mid(Jzs, a(j) + 1, 1)
    
54.         N2ChrX = N2ChrX & p
    
55.     Next
    
56. End Function
    
57. Function ChrX2N(ByVal S As String, ByVal N As Integer) As Long
    
58.     '作用：字符串值转换为 N 进制所表示的字符串
    
59.     '参数说明 S 要转换的N进制字符串, N (2-36) 对S变量进制数的说明
    
60.     Const Jzs As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    
61.     S = UCase(S)
    
62.     Dim a() As Byte, m As Double, i%, j%, t%
    
63.     a = S
    
64.     j = UBound(a)
    
65.     t = (UBound(a) + 1) / 2 - 1
    
66.     For i = 0 To j Step 2
    
67.         If a(i) < 64 Then
    
68.             m = m + (a(i) - 48) * N ^ t
    
69.             t = t - 1
    
70.         Else
    
71.             m = m + (a(i) - 55) * N ^ t
    
72.             t = t - 1
    
73.         End If
    
74.     Next
    
75.     If m > 2147483647 Then ChrX2N = m - 4294967296# Else ChrX2N = m
    
76. End Function
    

复制代码

[ 本帖最后由 ldy 于 2009-10-21 17:28 编辑 ]

alzeng

是否在这里只需做到36进制之内即可？

biaotiger1

个人理解哦

lz表示的N进制规定用常量中的字母哦
比如如果我要求将10进制转换为10进制，而这10进制用中文表示（一以已亿意易依伊亦咦）

这是不也是一种方式捏
-----------------------------------------------------------------------------------------------------------------------
按照lz斑竹所表示的常量范围，应该仅限于36进制内的了。如果出现37，打他PP
-----------------------------------------------------------------------------------------------------------------------
个人理解，不知当否。还请lz斑竹明示，以利答题

[ 本帖最后由 biaotiger1 于 2009-9-23 08:04 编辑 ]

zhoukick

占位

biaotiger1

原帖由 泓() 于 2009-9-23 08:06 发表
题还没做，先站位！！
与2楼同感 十六进制按你的常量（常量作什么用的?） 换算后如32=1G 而Hex（32）=20  两值不相同
你的2-36进制是否改变了原来进制如Hex等应该有的值

还是给出你的验证答案比较适当
比如 65 ...

正数相对简单些，负数我不会
一堆的数，看着就迷糊

ldy

dim L as long,N As Integer
L = -1
N = 19 ' 限 2 到36
msgbox  N2ChrX(L,8)  = Oct(L)
msgbox  N2ChrX(L,16)  = Hex(L)
msgbox  N2ChrX(L,10)  = Cstr(L)
msgbox  ChrX2N(Hex(L),16)  = L
msgbox  ChrX2N(Oct(L),8)  = L
msgbox  ChrX2N(Cstr(L),10)  = L
msgbox  ChrX2N(N2ChrX(L,N),N) =L

不管 L = 什么长整数 ，上面7 个消息框 都应该显示 TRUE
8 和 16进制 可以用VBA自带函数检验,至于其他进制，给几个边界值参考下。

HEX 和 OCT 是如何处理 负数的，你的代码也要按照此规律编写。
只要你编写的函数中不使用 Hex  和 Oct 函数，而
msgbox  N2ChrX(L,8)  = Oct(L)
msgbox  N2ChrX(L,16)  = Hex(L)
上面这两个等式成立，其他的进制转换自然迎刃而解。

0             = 17进制字符串 "0"
1             = 17进制字符串 "1"
10            = 17进制字符串 "A"
-1             = 17进制字符串 "A7FFDA90"
2147483647    = 17进制字符串 "53G7F548"
-2147483648    = 17进制字符串 "53G7F549"

0             = 18进制字符串 "0"
1             = 18进制字符串 "1"
10            = 18进制字符串 "A"
-1             = 18进制字符串 "704HE7G3"
2147483647    = 18进制字符串 "3928G3H1"
-2147483648    = 18进制字符串 "3928G3H2"

0             = 11进制字符串 "0"
1             = 11进制字符串 "1"
10            = 11进制字符串 "A"
-1             = 11进制字符串 "1904440553"
2147483647    = 11进制字符串 "A02220281"
-2147483648    = 11进制字符串 "A02220282"

0             = 9进制字符串 "0"
1             = 9进制字符串 "1"
10            = 9进制字符串 "11"
-1             = 9进制字符串 "12068657453"
2147483647    = 9进制字符串 "5478773671"
-2147483648    = 9进制字符串 "5478773672"

0             = 4进制字符串 "0"
1             = 4进制字符串 "1"
10            = 4进制字符串 "22"
-1             = 4进制字符串 "3333333333333333"
2147483647    = 4进制字符串 "1333333333333333"
-2147483648    = 4进制字符串 "2000000000000000"

0             = 16进制字符串 "0"
1             = 16进制字符串 "1"
10            = 16进制字符串 "A"
-1             = 16进制字符串 "FFFFFFFF"
2147483647    = 16进制字符串 "7FFFFFFF"
-2147483648    = 16进制字符串 "80000000"

0             = 36进制字符串 "0"
1             = 36进制字符串 "1"
10            = 36进制字符串 "A"
-1             = 36进制字符串 "1Z141Z3"
2147483647    = 36进制字符串 "ZIK0ZJ"
-2147483648    = 36进制字符串 "ZIK0ZK"

ldy

[quote]原帖由 biaotiger1 于 2009-9-23 08:01 发表
个人理解哦

lz表示的N进制规定用常量中的字母哦
比如如果我要求将10进制转换为10进制，而这10进制用中文表示（一以已亿意易依伊亦咦）

这是不也是一种方式捏
--------------------------------------------- ... [/quote]


10 进制转换 10进制，无变化，不用转换，直接函数内赋值就行了。
其他理解正确。
本来想加一些中文在常量中，弄个500进制的，考虑到繁体简体的问题不便验证，就只用36个数字和英文字母了。
其实道理是一样的，这道题如果作对了，只要增加常量的字符数，2000进制也没问题。

jmouse

16进制没有1G，因为用的字符只能到F。
负数的表示跟总位数有关，这里应该是不考虑的吧。
其实还有个小数的问题，比负数复杂一些。

邮件已发，请查收。

[ 本帖最后由 jmouse 于 2009-9-23 13:46 编辑 ]



收到 ，负数也要考虑的。在 8楼 有说明——ldy

jmouse

呃，没有注意到8楼有关负数的说明。
已经重发邮件，请查收。


收到 -ldy

1. 
   
2. '论坛ID: jmouse OK +2
   
3. Function N2ChrX(ByVal L As Long, ByVal N As Integer) As String
   
4.     '作用：将Long值转换为 N 进制所表示的字符串
   
5.     '参数说明 L 要转换的值, N (2-36) 将要使用的进制数
   
6.     Const Jzs As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
   
7.     If N = 10 Then
   
8.         N2ChrX = L
   
9.     Else
   
10.         If L < 0 Then
    
11.             x = Int((2 ^ 32 + L) / N)
    
12.             m = 2 ^ 32 + L - x * N
    
13.             N2ChrX = Mid(Jzs, m + 1, 1) + N2ChrX
    
14.             L = x
    
15.         End If
    
16.         While L >= N
    
17.             m = L - Int((L / N)) * N
    
18.             N2ChrX = Mid(Jzs, m + 1, 1) + N2ChrX
    
19.             L = Int((L / N))
    
20.         Wend
    
21.         N2ChrX = Mid(Jzs, L + 1, 1) + N2ChrX
    
22.     End If
    
23. End Function
    
24. Function ChrX2N(ByVal s As String, ByVal N As Integer) As Long
    
25.     '作用：字符串值转换为 N 进制所表示的字符串
    
26.     '参数说明 S 要转换的N进制字符串, N (2-36) 对S变量进制数的说明
    
27.     Const Jzs As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    
28.     s = UCase(s)
    
29.     If N = 10 Then
    
30.         ChrX2N = s
    
31.     Else
    
32.         i = 1
    
33.         Dim tmp As Double
    
34.         While s <> ""
    
35.             tmp = (InStr(1, Jzs, Right(s, 1)) - 1) * i + tmp
    
36.             s = Left(s, Len(s) - 1)
    
37.             i = i * N
    
38.         Wend
    
39.         If tmp > 2147483647 Then
    
40.             ChrX2N = tmp - 2 ^ 32
    
41.         Else
    
42.             ChrX2N = tmp
    
43.         End If
    
44.     End If
    
45. End Function
    

复制代码

[ 本帖最后由 ldy 于 2009-10-21 17:27 编辑 ]