ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
楼主: ldy

[Excel 程序开发] [第53期]EXCEL26进制来回转换 ---------已结

[复制链接]

TA的精华主题

TA的得分主题

发表于 2009-9-26 13:32 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
原帖由 shuts32 于 2009-9-25 23:29 发表
谢谢刘版送分,这次检大便宜了,,哇哈哈!!


送分? EH每拿一分都难 我不觉得是送分题
你还没有看见吗 多少版主 被此题忽悠了或“坑了”

TA的精华主题

TA的得分主题

发表于 2009-9-28 08:11 | 显示全部楼层
泓兄言之在理,只是小弟我学艺不精,今得分,甚悦之。

可能这题我的思路跟上了。

TA的精华主题

TA的得分主题

发表于 2009-9-28 09:26 | 显示全部楼层
原帖由 shuts32 于 2009-9-28 08:11 发表
泓兄言之在理,只是小弟我学艺不精,今得分,甚悦之。

可能这题我的思路跟上了。

我每拿一分都要熬上几宿,那个困哪 谁不睡觉谁知道

TA的精华主题

TA的得分主题

发表于 2009-10-16 09:27 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
发晚了,请ldy版版接收

收到



  1. 'ID laoyebin  'N2Char26(26)=A@  26的整倍数转换错误,+1
  2. Function N2Char26R(ByVal L As String) As Double
  3.     L = UCase(L)
  4.     Dim i%
  5.     If Len(L) = 1 Then
  6.         N2Char26R = Asc(L) - 64
  7.     Else
  8.         For i = 1 To Len(L) - 1
  9.             N2Char26R = N2Char26R + (Asc(Mid$(L, i, 1)) - 64) * 26 ^ (Len(L) - i)
  10.         Next
  11.         N2Char26R = N2Char26R + Asc(Right$(L, 1)) - 64
  12.     End If
  13. End Function


  14. Function N2Char26(ByVal L As Double) As String
  15. 'N2Char26(26)=A@  这个错误
  16. Dim iMod As Integer, dInt As Double, sChar As String, k As Byte
  17.     iMod = Int(Application.WorksheetFunction.Log(L, 26))
  18.     For x = iMod To 0 Step -1
  19.         k = Int(L / 26 ^ x)
  20.         L = L - k * 26 ^ x
  21.         sChar = sChar & Chr(k + 64)
  22.     Next
  23.     N2Char26 = sChar
  24. End Function
复制代码

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

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2009-10-20 22:35 | 显示全部楼层
答案刚刚发送,请查收。




  1. 'ID:  chrisfang ok +3
  2. Function N2Char26R(ByVal l As String) As Double
  3.     '你的代码 要求EXCEL2003下可运行
  4.     slen = Len(l)
  5.     For i = 1 To slen
  6.         sChar = Mid(UCase(l), slen - i + 1, 1)
  7.         sNum = Asc(sChar) - 64
  8.         N2Char26R = N2Char26R + sNum * 26 ^ (i - 1)
  9.     Next i
  10. End Function

  11. Function N2Char26(ByVal l As Double) As String
  12.     '你的代码 要求EXCEL2003下可运行
  13.     '具体要求请运行 验证2
  14.     Dim iMod As Integer, dInt As Double, sChar As String
  15.     'Application.Volatile
  16.     dInt = Int(l / 26)
  17.     iMod = l - dInt * 26
  18.     If iMod > 0 Then
  19.         sChar = Chr(iMod + 64)
  20.     ElseIf dInt > 0 Then
  21.         dInt = dInt - 1
  22.         sChar = "Z"
  23.     End If
  24.    
  25.     Do While dInt > 0
  26.         S = dInt
  27.         dInt = Int(dInt / 26)
  28.         iMod = S - dInt * 26
  29.         If iMod > 0 Then
  30.             sChar = Chr(iMod + 64) & sChar
  31.         ElseIf dInt > 0 Then
  32.             dInt = dInt - 1
  33.             sChar = "Z" & sChar
  34.         End If
  35.     Loop
  36.    
  37.     N2Char26 = sChar
  38. End Function
复制代码

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

评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2009-10-21 18:38 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

结贴

EXCEL26进制来回转换 和 玩转N进制 两道VBA题目极其类似,放到一起做为结贴
EXCEL26进制来回转换   http://club.excelhome.net/thread-484032-1-1.html
玩转N进制 http://club.excelhome.net/thread-485781-1-1.html
----------------------------------------------------------------------------
EXCEL26进制来回转换   http://club.excelhome.net/thread-484032-1-1.html
先看下我的代码,
'ID :ldy
Function N2Char26(ByVal L As Double) As String
    Do While L > 0
        N2Char26 = Chr(L - Int(L / (26.0000000000001)) * 26 + 64) & N2Char26
        L = Int(L / (26.0000000000001))
    Loop
End Function
Function N2Char26(ByVal L As Double) As String '第二版本,稍微慢一点,便于和玩转N进制比较
    Const Jzs As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    Do
        N2Char26 = Mid(Jzs, L - Int(L / 26.0000000000001) * 26, 1) & N2Char26
        L = Int(L / (26.0000000000001))
    Loop While L > 0
End Function
Function N2Char26R(ByVal L As String) As Double
    L = UCase(L)
    For i% = 1 To Len(L)
        N2Char26R = N2Char26R + (Asc(Mid(L, i)) - 64) * 26 ^ (Len(L) - i)
    Next
End Function

N2Char26R 所有参赛者的代码都大同小异,送分的机会,
重点在N2Char26, 把10进制数转换为A-Z 26个字母表示的字符串。为什么有两个版本,看下去就知道了
EXCEL26进制 与通常所提到的 2进制、8进制、10进制、16进制不同,区别在于这种进制是没有0位的,
这一点很容易被忽略,很多人只得了1分,就是因为这个原因,代码中没有处理26的整倍数的情况,
结果26、52 等26的倍数值转换错误,验证也很简单,只要是26的整倍数,转换后的最后一个字符一定是 Z
这个代码是合并语句后的结果,没有其他变量,虽然牺牲了一点效率的,看起来简洁一些,接着做玩转N进制的时候方便比较。
还原一下第一个版本:
Function N2Char26(ByVal L As Double) As String
   Do
        Y% = L - Int(L / 26) * 26' 余数
        L = Int(L / 26)' 算出除以26的倍数, 商
        If Y = 0 Then '余数为0 则倍数-1 余数+26 ,没有考虑到这一点,就少了2分
            L = L - 1
            Y = Y + 26
        End If
        N2Char26 = Chr(Y + 64) & N2Char26 ' 根据余数,按照字符集取得对应的字符
    Loop  While L > 0
End Functio
解题思路大致如下
1 算出余数
2 算出整倍数,商
3 如果余数为0 则倍数-1 余数+26 ,如果是常规有0位的进制则不用考虑
4 按照余数组织字符串
如此循环 直到倍数为 0
VBA 里常用的 两个运算符 Mod 和 整除 \ ,处理数据有限制,就是不能超出Long值的范围,不能直接使用。
算余数 用  L - Int(L / 26) * 26 来代替 L Mom 26
取整倍数用 Int(L / 26) 代替 L \ 26。

继续想一想,如何让余数算出来永远都不为 0,那就要除以一个仅仅比26大一点点的小数26.000000001,
也就是 26 + 极小数
还是这个代码变化一下
Function N2Char26(ByVal L As Double) As String
   Do
        Y% = L - Int(L / 26.00000001) * 26' 余数 这样一来26/26.0000001 的余数 Y 就是 26,不会是0 了
        L = Int(L / 26.00000001)  ' 算出除以26+极小数的倍数 26 就是26.0000001的 0.几倍 整倍数是0 不用-1了
        N2Char26 = Chr(Y + 64) & N2Char26 ' 根据余数,按照字符集取得对应的字符
    Loop  While L > 0
End Functio
还有一个问题,26+极小数 中间到底多少个 0 合适?
Double 的处理精度是15位数字,不含小数点,所以中间 12个0 刚好刚好15位。把变量代入合并后就成了那个4行的代码。

玩转N进制 http://club.excelhome.net/thread-485781-1-1.html
,看起来比 26进制要难,其实要容易一些,网上有现成的代码,但不能转化负数。
需要了解的就是 Long值负数的问题。
很多人26 进制做错的代码拿过来,修改下取字符的方法,就是 玩转N进制的正确答案。纯粹的送分题,似乎鲜少有人轻松得分。
我的代码:
Function N2ChrX(ByVal L As Long, N As Integer) As String
    Const Jzs As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    Dim v As Double, x As Double, y As Long
    If N = 10 Then N2ChrX = L: Exit Function' 10进制转10进制没必要处理,直接赋值
    v = L - (L < 0) * 4294967296#  '把负数转为 正数 赋值给 Double
    Do
        N2ChrX = Mid(Jzs, v - Int(v / N) * N + 1, 1) & N2ChrX
        v = Int(v / N)
    Loop While v > 0
End Function

Function ChrX2N(ByVal S As String, N As Integer) As Long
    Const Jzs As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    Dim i%, v As Double
    S = UCase(S)
    If N = 10 Then ChrX2N = S: Exit Function
    For i = 1 To Len(S)
        v = v + (InStr(Jzs, Mid$(S, i, 1)) - 1) * N ^ (Len(S) - i)
    Next
    ChrX2N = v + (v > 2147483647) * 4294967296#   
End Function

ChrX2N 和 N2Char26R 几乎一样,都是字符转换为数字 ,只是多了个参数表示进制数
这两个函数除了名称变量不同,一个是从常量中取顺序值,一个是字符表中取Asc码,其他都一样。
26进制那题能拿到分的,这两分几乎就是白给的。唯一要注意的就是借助Double来过渡。


比较有趣的是Long值转换为字符串:N2ChrX

Long值有负数,但其实也是一种序列,有4294967296(2^32) 个成员,0是第 1个,-1 是最后一个。-1的序列数就是4294967296
如果把0 当作是第 “0”个, 那么 -1的序列数就是4294967295

解题思路:

先判断是否负数,把负数转为 正数 赋值给 Double
后面的就直接套用 N2Char26 函数的思路:
   Do
        Y% = L - Int(L / 26) * 26' 余数
        L = Int(L / 26)' 算出除以26的倍数
        If  Y = 0 Then '余数为0 则倍数-1 余数+26 ,没有考虑到这一点,就少了2分
          L = L - 1
          Y = Y + 26
         End If
        N2Char26 = Chr(Y + 64) & N2Char26 ' 根据余数,按照字符集取得对应的字符
    Loop  While L > 0


因为有0位,余数为0的情况不用管了,仅仅把变量名称改一改
    Do
        Y% = V - Int(V / N) * N' 余数
        V = Int(L / N)' 算出除以N的倍数
        N2ChrX = Mid(Jzs, Y - 1, 1) & N2ChrX
    Loop While v > 0
再把变量、代入合并,就是我的代码了。

把这两个代码中的循环中的部分放在一起比较一下,(第二版本的)
        N2Char26 = Mid(Jzs, L - Int(L / 26.0000000000001) * 26   ,  1) & N2Char26
        L = Int(L / 26.0000000000001)

        N2ChrX   = Mid(Jzs,  V - Int(V / N                             ) * N + 1, 1) & N2ChrX
        V = Int(V / N)

这两函数的核心部分其实就差那么一点点----- 0.0000000000001,也就是说是否需要处理余数为 0 的情况。

N2ChrX 和  ChrX2N 只要修改其中的Jzs常量,你就有了自己独门的进制转换标准,把这对函数应用到程序的加密,注册码计算当中,可以很大的提高破解难度。

TA的精华主题

TA的得分主题

发表于 2009-10-21 21:27 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
N2Char26(26)=A@ 26的整倍数转换错误,+1
我狂晕啊,海过了,栽臭水沟里了

TA的精华主题

TA的得分主题

发表于 2009-10-22 08:39 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
第二题我的答案(26楼)和35楼的一模一样,为啥算我错啊。。。
不同的地方用蓝色标出了。。

我的代码:
Function N2Char26(ByVal L As Double) As String
'你的代码 要求EXCEL2003下可运行
'具体要求请运行 验证2
    Dim iMod As Long, dInt As Double, sChar As String
    'Application.Volatile
    dInt = Int(L / 26)
    iMod = L - dInt * 26
    If iMod > 0 Then
        sChar = Chr(64 + iMod)
    ElseIf dInt > 0 Then
        dInt = dInt - 1
        sChar = "Z"
    End If
    Do While dInt > 0
        iMod = dInt - Int(dInt / 26) * 26
        dInt = Int(dInt / 26)

        If iMod > 0 Then
            sChar = Chr(64 + iMod) & sChar
        ElseIf dInt > 0 Then
            dInt = dInt - 1
            sChar = "Z" & sChar
        End If
    Loop
    N2Char26 = sChar
End Function

35楼的代码:
Function N2Char26(ByVal l As Double) As String
    '你的代码 要求EXCEL2003下可运行
    '具体要求请运行 验证2
    Dim iMod As Integer, dInt As Double, sChar As String
    'Application.Volatile
    dInt = Int(l / 26)
    iMod = l - dInt * 26
    If iMod > 0 Then
        sChar = Chr(iMod + 64)
    ElseIf dInt > 0 Then
        dInt = dInt - 1
        sChar = "Z"
    End If
   
    Do While dInt > 0
        S = dInt
        dInt = Int(dInt / 26)
        iMod = S - dInt * 26

        If iMod > 0 Then
            sChar = Chr(iMod + 64) & sChar
        ElseIf dInt > 0 Then
            dInt = dInt - 1
            sChar = "Z" & sChar
        End If
    Loop
   
    N2Char26 = sChar
End Function

TA的精华主题

TA的得分主题

 楼主| 发表于 2009-10-22 14:57 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
原帖由 amulee 于 2009-10-22 08:39 发表
第二题我的答案(26楼)和35楼的一模一样,为啥算我错啊。。。
不同的地方用蓝色标出了。。

我的代码:
Function N2Char26(ByVal L As Double) As String
'你的代码 要求EXCEL2003下可运行
'具体要求请运行 验 ...


代码中 做了记录 是 OK +3
评分的时候看错楼层了,已撤销重评。
人一多,眼花了 ,抱歉。
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-11-24 05:15 , Processed in 0.035541 second(s), 9 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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