ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
123
返回列表 发新帖
楼主: ldy

[Excel 程序开发] [53期国庆附加题] 玩转 N 进制 -----------已结

[复制链接]

TA的精华主题

TA的得分主题

发表于 2009-9-30 09:04 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助

佳节将至,刘版送分
谢谢斑竹,礼物收到

要知道我的第一版效率指数696呢
第二个小板凳虽然不好,但比第一个好多了

在鼓励自己的时候也不的不承认——差距还是很大滴,我对算法方面的考虑太少

TA的精华主题

TA的得分主题

发表于 2009-9-30 09:14 | 显示全部楼层
邮件已发送,请版主查收。



[ 本帖最后由 incognito 于 2009-9-30 09:15 编辑 ]


收到,但未按题目要求答题, 时间还早,请按统一格式答题-ldy


  1. 'Excel Home ID: incognito   结果正确,但未按题目要求答题  不评分
  2. '=================================================================
  3. Function N2ChrX(ByVal L As Variant, N As Integer) _
  4. As String
  5.     Const sDigits As String = "123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  6.     Const MaxLen = 56
  7.    
  8.     Dim sNumber As String
  9.     Dim p As Integer
  10.     Dim iDigit As Integer
  11.     Dim PrevValue As Variant
  12.    
  13.     If N = 10 Then
  14.     N2ChrX = L
  15.     Exit Function
  16.     End If
  17.     If L < 0 Then
  18.     L = L + 4294967296#
  19.     End If
  20.         
  21.     sNumber = String$(MaxLen, "0")
  22.     p = MaxLen + 1
  23.    
  24.     Do While L > 0
  25.     PrevValue = L
  26.     L = Int(L / N)
  27.     iDigit = PrevValue - L * N
  28.     p = p - 1
  29.     If iDigit Then Mid$(sNumber, p, 1) = Mid$(sDigits, iDigit, 1)
  30.     Loop
  31.    
  32.     If p > MaxLen Then p = p - 1
  33.    
  34.     N2ChrX = Mid$(sNumber, p)
  35. End Function
  36. '**************************************************************************************************
  37. Function ChrX2N(ByVal L As String, ByVal N As Integer) As Variant
  38.     Dim index As Long
  39.     Dim digits As String
  40.     Dim digitValue As Variant
  41.     Const sDigits As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  42.     If N < 2 Or N > 36 Then Err.Raise 5
  43.     digits = Left(sDigits, N)
  44.   
  45.     If N = 10 Then
  46.     ChrX2N = L
  47.     Exit Function
  48.     End If
  49.    
  50.     For index = 1 To Len(L)
  51.         digitValue = InStr(1, digits, Mid$(L, index, 1), _
  52.             vbTextCompare) - 1
  53.         If digitValue < 0 Then Exit Function
  54.         ChrX2N = ChrX2N * N + digitValue
  55.     Next
  56.     If ChrX2N > 2147483647# Then
  57.     ChrX2N = ChrX2N - 4294967296#
  58.     End If
  59. End Function
复制代码


结果正确,但未按题目要求答题 ,并且抄袭痕迹太明显,不予评分。
参考 http://www.keyongtech.com/957569-convert-a-nine-digit-number

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

TA的精华主题

TA的得分主题

发表于 2009-10-2 16:51 | 显示全部楼层
占位。邮件已发,请查收。
国庆快乐!



  1. 'ID:蓝桥玄霜  结果正确 ,但负数转换太慢,影响整个速度 + 2
  2. Function N2ChrX(ByVal L As Long, ByVal N As Integer) As String
  3.     '作用:将Long值转换为 N 进制所表示的字符串
  4.     '参数说明 L 要转换的值, N (2-36) 将要使用的进制数
  5.     Dim iMod As Integer, dInt As Double, sChar As String
  6.     Dim ws&, fws&, zxx, i&, j&, nf$, bb$, a$, a1$, a2$, b, wc, w&, j1
  7.     Dim wszd&, wszx&, jw&, zdzf$, s1, n2, c, c1, n1
  8.     Const Jzs As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  9.     Const zd& = 2147483647
  10.     Const zx& = -2147483648#
  11.    
  12.     If N = 10 Then N2ChrX = L: Exit Function
  13.     If L = 0 Then N2ChrX = L: Exit Function
  14.     If L > 0 Then
  15.         iMod = L Mod N
  16.         dInt = Int(L / N)
  17.         If iMod > 0 Then
  18.             sChar = Mid$(Jzs, iMod + 1, 1)
  19.         ElseIf dInt > 0 Then
  20.             sChar = "0"
  21.         End If
  22.         Do While dInt > 0
  23.             iMod = dInt Mod N
  24.             dInt = Int(dInt / N)
  25.             If iMod > 0 Then
  26.                 sChar = Mid$(Jzs, iMod + 1, 1) & sChar
  27.             ElseIf dInt > 0 Then
  28.                 sChar = "0" & sChar
  29.             End If
  30.         Loop
  31.     Else
  32.         zdzf = N2ChrX(zd, N)
  33.         wszd = Len(zdzf)
  34.         If L = zd Then N2ChrX = zdzf: Exit Function
  35.         jw = 1: i = wszd   'zdzf+1求得最小值zxx
  36.         Do While jw = 1 And i > 0
  37.             a = Mid$(zdzf, i, 1)
  38.             n2 = InStr(Jzs, a) - 1
  39.             c = n2 + 1
  40.             If c < N Then
  41.                 c1 = Mid$(Jzs, c + 1, 1)
  42.                 s1 = c1 & s1
  43.                 zxx = Left$(zdzf, i - 1) & s1
  44.                 GoTo 150
  45.             Else
  46.                 c1 = "0"
  47.                 s1 = c1 & s1
  48.                 i = i - 1
  49.             End If
  50.         Loop
  51.         If N = 2 Then zxx = "1" & s1
  52. 150:
  53.         wszx = Len(zxx)
  54.         wc = wszx - wszd
  55.         If wc > 0 Then
  56.             zdzf = Application.Rept("0", wc) & zdzf
  57.         End If
  58.         jw = 0: s1 = ""  'zdzf+zxx求得f1(-1)
  59.         For i = wszx To 1 Step -1
  60.             a = Mid$(zdzf, i, 1)
  61.             n2 = InStr(Jzs, a) - 1
  62.             b = Mid$(zxx, i, 1)
  63.             n1 = InStr(Jzs, b) - 1
  64.             c = n2 + n1
  65.             If jw = 1 Then
  66.                 c = c + 1
  67.             End If
  68.             If c < N Then
  69.                 c1 = Mid$(Jzs, c + 1, 1)
  70.                 jw = 0
  71.             ElseIf c = N Then
  72.                 c1 = "0"
  73.                 jw = 1
  74.             Else
  75.                 c = c Mod N
  76.                 c1 = Mid$(Jzs, c + 1, 1)
  77.                 jw = 1
  78.             End If
  79.             s1 = c1 & s1
  80.         Next i
  81.         If jw = 1 Then
  82.             s1 = "1" & s1
  83.         End If
  84.         f1 = s1
  85.         If L = zx Then
  86.             N2ChrX = zxx
  87.             Exit Function
  88.         ElseIf L = -1 Then N2ChrX = f1: Exit Function
  89.         Else
  90.             L = -L - 1
  91.         End If
  92.         ws1 = Len(f1)
  93.         nf = N2ChrX(L, N)    '求得正的L-1的代码
  94.         fws = Len(nf)
  95.         wc = ws1 - fws
  96.         If wc > 0 Then
  97.             nf = Application.Rept("0", wc) & nf
  98.         End If
  99.         jw = 0: s1 = ""
  100.         For i = ws1 To 1 Step -1
  101.             a = Mid$(f1, i, 1)
  102.             n2 = InStr(Jzs, a) - 1
  103.             b = Mid$(nf, i, 1)
  104.             n1 = InStr(Jzs, b) - 1
  105.             c = n2 - n1
  106.             If c >= 0 Then
  107.                 If jw = 1 Then
  108.                     c = c - 1
  109.                     If c >= 0 Then
  110.                         If i = 1 And c = 0 And jw = 1 Then sChar = s1: GoTo 300
  111.                         c1 = Mid$(Jzs, c + 1, 1)
  112.                         s1 = c1 & s1
  113.                         jw = 0
  114.                     Else
  115.                         c = c + N + 1
  116.                         c1 = Mid$(Jzs, c, 1)
  117.                         jw = 1
  118.                         s1 = c1 & s1
  119.                     End If
  120.                 Else
  121.                     c1 = Mid$(Jzs, c + 1, 1)
  122.                     s1 = c1 & s1
  123.                     jw = 0
  124.                 End If
  125.             Else
  126.                 c = c + N + 1
  127.                 If jw = 1 Then c = c - 1
  128.                 c1 = Mid$(Jzs, c, 1)
  129.                 jw = 1
  130.                 s1 = c1 & s1
  131.             End If
  132.         Next i
  133.         If jw = 1 Then
  134.             c = c - 1
  135.             c1 = Mid$(Jzs, c + 1, 1)
  136.             s1 = c1 & s1
  137.         End If
  138.         sChar = s1
  139.     End If
  140. 300:
  141.     N2ChrX = sChar
  142. End Function
  143. Function ChrX2N(ByVal S As String, ByVal N As Integer) As Long
  144.     '作用:字符串值转换为 N 进制所表示的字符串
  145.     '参数说明 S 要转换的N进制字符串, N (2-36) 对S变量进制数的说明
  146.     Dim ws&, fws&, i&, j&, j1, a$, b$, sChar$, suz, zxx
  147.     Dim fs&, zdzf, wszd&, wszx&, c, s1, c1, n2, n1, f1$, jw&
  148.     Const Jzs As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  149.     Const zd& = 2147483647
  150.     Const zx& = -2147483648#
  151.     If N = 10 Then ChrX2N = S: Exit Function
  152.     S = UCase(S)
  153.     ws = Len(S)
  154.     '判断正负数
  155.     If N = 16 And Left$(S, 1) > "7" And ws = 8 Then
  156.         fs = 1: GoTo 100
  157.     ElseIf N = 16 And ws < 8 Then
  158.         GoTo 200
  159.     End If
  160. 100:
  161.     zdzf = N2ChrX(zd, N)
  162.     wszd = Len(zdzf)
  163.     If ws < wszd Then
  164.         GoTo 200
  165.     ElseIf ws = wszd Then
  166.         If S > zdzf Then fs = 1: GoTo 120
  167.         GoTo 200
  168.     Else
  169.         fs = 1
  170.     End If
  171. 120:
  172.     '是负数时,执行下面代码
  173.     If S = zdzf Then ChrX2N = zd: Exit Function
  174.     If S = "0" Then ChrX2N = S: Exit Function
  175.     jw = 1: i = wszd   'zdzf+1求得最小值zxx
  176.     Do While jw = 1 And i > 0
  177.         a = Mid$(zdzf, i, 1)
  178.         n2 = InStr(Jzs, a) - 1
  179.         c = n2 + 1
  180.         If c < N Then
  181.             c1 = Mid$(Jzs, c + 1, 1)
  182.             s1 = c1 & s1
  183.             zxx = Left$(zdzf, i - 1) & s1
  184.             GoTo 150
  185.         Else
  186.             c1 = "0"
  187.             s1 = c1 & s1
  188.             i = i - 1
  189.         End If
  190.     Loop
  191.     If N = 2 Then zxx = "1" & s1
  192. 150:
  193.     wszx = Len(zxx)
  194.     wc = wszx - wszd
  195.     If wc > 0 Then
  196.         zdzf = Application.Rept("0", wc) & zdzf
  197.     End If
  198.     jw = 0: s1 = ""  'zdzf+zxx求得f1(-1)
  199.     For i = wszx To 1 Step -1
  200.         a = Mid$(zdzf, i, 1)
  201.         n2 = InStr(Jzs, a) - 1
  202.         b = Mid$(zxx, i, 1)
  203.         n1 = InStr(Jzs, b) - 1
  204.         c = n2 + n1
  205.         If jw = 1 Then
  206.             c = c + 1
  207.         End If
  208.         If c < N Then
  209.             c1 = Mid$(Jzs, c + 1, 1)
  210.             jw = 0
  211.         ElseIf c = N Then
  212.             c1 = "0"
  213.             jw = 1
  214.         Else
  215.             c = c Mod N
  216.             c1 = Mid$(Jzs, c + 1, 1)
  217.             jw = 1
  218.         End If
  219.         s1 = c1 & s1
  220.     Next i
  221.     If jw = 1 Then
  222.         s1 = "1" & s1
  223.     End If
  224.     f1 = s1
  225.     If S = f1 Then ChrX2N = "-1": Exit Function
  226.     If S = zxx Then ChrX2N = zx: Exit Function
  227.     ws1 = Len(f1)
  228.     wc = ws1 - ws
  229.     If wc > 0 Then
  230.         S = Application.Rept("0", wc) & S
  231.     End If
  232.     jw = 0
  233.     For i = ws1 To 1 Step -1  '-1减S的代码
  234.         a = Mid$(f1, i, 1)
  235.         n2 = InStr(Jzs, a)
  236.         b = Mid$(S, i, 1)
  237.         n1 = InStr(Jzs, b)
  238.         c = n2 - n1
  239.         If jw = 1 Then
  240.             c = c - 1
  241.             If i = 1 And c = 0 Then jw = 0: Exit For
  242.             If c >= 0 Then
  243.                 jw = 0
  244.             Else
  245.                 c = c + N
  246.                 jw = 1
  247.             End If
  248.         ElseIf c < 0 Then
  249.             c = c + N
  250.             jw = 1
  251.         End If
  252.         suz = suz + c * N ^ m
  253.         m = m + 1
  254.     Next i
  255.     If jw = 1 Then
  256.         c = c - 1
  257.         suz = suz + c * N ^ m
  258.     End If
  259.     GoTo 300
  260. 200:
  261.     For i = ws To 1 Step -1
  262.         a = Mid$(S, i, 1)
  263.         If a <> "0" Then
  264.             b = InStr(Jzs, a) - 1
  265.             suz = suz + b * N ^ m
  266.         End If
  267.         m = m + 1
  268.     Next i
  269. 300:
  270.     If fs = 0 Then
  271.         ChrX2N = suz
  272.     Else
  273.         ChrX2N = -suz - 1
  274.     End If
  275. End Function
复制代码

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

评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2009-10-21 18:39 | 显示全部楼层

结贴

EXCEL26进制来回转换 和 玩转N进制 两道VBA题目及其类似,放到一起做为结贴
http://club.excelhome.net/viewth ... p;page=4#pid3244334

TA的精华主题

TA的得分主题

发表于 2010-9-2 12:57 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
学习之。

负数规律算明白了。
-2147483647~-1
加上2^32转换为正数,
2147483649~4294967295
再进行进制计算……
非10进制的负数显得比正数还要大。


小数规律不清楚。

[ 本帖最后由 香川群子 于 2010-9-2 16:53 编辑 ]
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-29 23:38 , Processed in 0.048599 second(s), 9 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表