查看: 6690|回复: 19
十进制转换为二进制
阅读权限30
在线时间 小时
本帖已被收录到知识树中，索引项：
本帖最后由 清泉石上流shm 于
21:18 编辑
各位大侠们，版主们：
& && &急救啊！！！
请看下面的代码：
& & Open ThisWorkbook.Path & &\YSLX.dat& For Binary As #1
& & Get #1, 1, YSLX
& & Close #1
& & F = Application.dec2bin(YSLX, 8)& && &‘单元格可以用DEC2BIN(A1,8)的，在程序中怎么用呢？这里想将得到的YSLX值变成二进制文本字符串！！！
阅读权限70
在线时间 小时
阅读权限95
在线时间 小时
本帖最后由 香川群子 于
20:33 编辑
这么简单的事……自己写一段自定义函数代码就解决了。
Function myBin(N, Optional l = 8)
& & If N & 2 ^ l - 1 Then l = Int(Log(N) / Log(2)) + 1 '超过指定数位时，计算返回合适的数位。& &
& & Do
& && &&&s = N Mod 2 & s '从个位起，计算除以2的余数0或1，作为二进制结果返回
& && &&&N = N \ 2 '迭代计算除以2的整数部分
& & Loop While N '整数&0时继续（直到=0时停止）
& & myBin = Right(String(l, &0&) & s, l) '按指定数位输出结果，默认输出8位 (超过指定数位时自动返回合适数位)
End Function复制代码
阅读权限95
在线时间 小时
任意进制转换的自定义函数：
x为转换对象数值，n为将要转化的进制，p为转换前进制（默认10进制），d为转换输出数位Function dec2base(x, n, Optional p = 10, Optional d = 0)
& & If p = 0 Then p = 10
& & If p = 10 And (x &= 2 ^ 31 Or x &= -2 ^ 31) Then Exit Function
& & If n & 2 Or n & 36 Or p & 2 Or p & 36 Then Exit Function
& &
& & If x & 0 Then x = x + 2 ^ 31: k = -1
& & If p & 10 Then
& && &&&For i = Len(x) To 1 Step -1
& && && && &y = y + Mid(x, i, 1) * p ^ (Len(x) - i)
& && &&&Next
& & ElseIf p = 10 Then
& && &&&y = x
& & ElseIf p & 10 Then
& && &&&For i = Len(x) To 1 Step -1
& && && && &y = y + IIf(IsNumeric(Mid(x, i, 1)), Mid(x, i, 1), Asc(Mid(x, i, 1)) - 55) * p ^ (Len(x) - i)
& && &&&Next
& & End If
& & If k = -1 Then
& && &&&For i = 1 To d
& && && && &dec2base = IIf(y Mod n & 10, y Mod n, Chr(y Mod n + 55)) & dec2base
& && && && &y = Int(y / n)
& && &&&Next
& & Else
& && &&&Do Until y = 0
& && && && &dec2base = IIf(y Mod n & 10, y Mod n, Chr(y Mod n + 55)) & dec2base
& && && && &y = Int(y / n)
& && &&&Loop
& && &&&If Len(dec2base) & d Then dec2base = Right(String(d, &0&) & dec2base, d)
& & End If
& &
End Function复制代码
阅读权限95
在线时间 小时
本帖最后由 香川群子 于
21:21 编辑
也可以直接用len(结果)来判断是否输出结果要添加0Function myBin(n, Optional l = 8)
'& & If n & 2 ^ l - 1 Then l = Int(Log(n) / Log(2)) + 1
& & Do
& && &&&myBin = n Mod 2 & myBin
& && &&&n = n \ 2
& & Loop While n
& & If Len(myBin) & l Then myBin = Right(String(l, &0&) & myBin, l)
End Function复制代码
阅读权限30
在线时间 小时
本帖最后由 清泉石上流shm 于
20:03 编辑
香川群子 发表于
也可以直接用len(结果)来判断是否输出结果要添加0
老师：帮我看看这个吧，没有人会，昨天看了你的上面的代码想自己利用你上面的代码写一个的，后来发现写了很多代码，这样对读取和写入的速度影响会比较大（本来的想法是根据读取或写入的位进行运算得到所在BYTE的位置然后处理这个byte），请帮我看看吧！
& &&&谢谢！
阅读权限30
在线时间 小时
本帖最后由 清泉石上流shm 于
21:03 编辑
清泉石上流shm 发表于
老师：帮我看看这个吧，没有人会，昨天看了你的上面的代码想自己利用你上面的代码写一个的，后来发现写 ...
下面的是我做的读取文件某一位的程序，但是写入就没有做出来
Function dubinwei(A As Long)
Dim Y As Byte
Dim F As String
Dim B As Long
Dim C As Integer
Dim Z As String
B = Int(A / 8)
C = A - B * 8
If C & 0 Then
& & Open ThisWorkbook.Path & &\Y.dat& For Binary As #1
& & Get #1, B + 1, Y
& & Close #1
& & Z = myBin(Y)
& & F = Mid(Z, C, 1)
& & Open ThisWorkbook.Path & &\Y.dat& For Binary As #1
& & Get #1, B, Y
& & Close #1
& & Z = myBin(Y)
& & F = Mid(Z, 8, 1)
End Function
Function myBin(N, Optional l = 8) As String
Dim s As String
& && &&&s = N Mod 2 & s
& && &&&N = N \ 2
& & Loop While N
& & myBin = Right(String(l, &0&) & s, l)
End Function
呵呵，下面的是你的程序，嘿嘿！
请老师帮忙看看，上面代码以更快么？写入某一位可以帮忙写下么？
阅读权限95
在线时间 小时
你直接说你想干什么，然后上附件啊。
你自己写的代码，肯定有值得改进的地方吧。
阅读权限30
在线时间 小时
& & & & & & & &
香川群子 发表于
你直接说你想干什么，然后上附件啊。
你自己写的代码，肯定有值得改进的地方吧。
原题目是这个：
& && & 通常我们写入和读取二进制是按照byte或其他的数据类型读取的，但是我想直接读取和写入某一个数据位这样该如何写代码？？
例如：我在文件的第513位写入0或者1&&，读出文件的第45613位的数据（0或者1）这样该如何写代码？？（数据位任意给定）
下面的是我做的读取文件某一位的程序，但是写入就没有做出来
Function dubinwei(A As Long)
Dim Y As Byte
Dim F As String
Dim B As Long
Dim C As Integer
Dim Z As String
B = Int(A / 8)
C = A - B * 8
If C & 0 Then
& & Open ThisWorkbook.Path & &\Y.dat& For Binary As #1
& & Get #1, B + 1, Y
& & Close #1
& & Z = myBin(Y)
& & F = Mid(Z, C, 1)
& & Open ThisWorkbook.Path & &\Y.dat& For Binary As #1
& & Get #1, B, Y
& & Close #1
& & Z = myBin(Y)
& & F = Mid(Z, 8, 1)
End Function
Function myBin(N, Optional l = 8) As String
Dim s As String
& && &&&s = N Mod 2 & s
& && &&&N = N \ 2
& & Loop While N
& & myBin = Right(String(l, &0&) & s, l)
End Function
阅读权限95
在线时间 小时
写入只能按照字节，一个字节一个字节地改。 不能按照 0 / 1 这样数位来改。
计算机不是按照1个数位单位来储存数据的。最低单位是一个字节。
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师只需一步，快速开始
扫一扫，访问微社区
查看: 385|回复: 6
HackVBASpeed 之进制转换,之二进制转十进制.极限挑战
标题有点浮夸了, 各位看官随便拍{:soso_e112:}, 有好的代码尽管来挑战{:soso_e129:}
进制转换基本在VBA常常遇到, 也是最基础的函数, 之前写的转换今天看来如果进行深度优化, 速度提升可能有100倍.
0. 不限语言(汇编,C,VB,API, TLB都可以),
1. 能在VBA环境调用,
2. 能完成1~32位内长度的二进制字符串转换
这个我目前收集到VBA速度最快的二进制转十进制, 德国人写的, 但可惜只能定长字符串(32字符长度)
当然这是我收集,不是我写的, 如果要重写定长转换, 速度还是很容易超过它的. 但定长的实用性不强, 写出后意义也不大.
Public Function BitToLong04(bitexpr As String) As Long
' by G.Beckmann, ,
' based on BitToLong03 by Egbert Nierop, ,
& & Static t%(31): Dim asc0%
& & If Len(bitexpr) && 32 Then Exit Function
& & RtlMoveMemory t(0), ByVal StrPtr(bitexpr), 64
& & asc0 = KeyCodeConstants.vbKey0
& & BitToLong04 = t(1) - asc0
& & BitToLong04 = 2 * BitToLong04 + t(2) - asc0
& & BitToLong04 = 2 * BitToLong04 + t(3) - asc0
& & BitToLong04 = 2 * BitToLong04 + t(4) - asc0
& & BitToLong04 = 2 * BitToLong04 + t(5) - asc0
& & BitToLong04 = 2 * BitToLong04 + t(6) - asc0
& & BitToLong04 = 2 * BitToLong04 + t(7) - asc0
& & BitToLong04 = 2 * BitToLong04 + t(8) - asc0
& & BitToLong04 = 2 * BitToLong04 + t(9) - asc0
& & BitToLong04 = 2 * BitToLong04 + t(10) - asc0
& & BitToLong04 = 2 * BitToLong04 + t(11) - asc0
& & BitToLong04 = 2 * BitToLong04 + t(12) - asc0
& & BitToLong04 = 2 * BitToLong04 + t(13) - asc0
& & BitToLong04 = 2 * BitToLong04 + t(14) - asc0
& & BitToLong04 = 2 * BitToLong04 + t(15) - asc0
& & BitToLong04 = 2 * BitToLong04 + t(16) - asc0
& & BitToLong04 = 2 * BitToLong04 + t(17) - asc0
& & BitToLong04 = 2 * BitToLong04 + t(18) - asc0
& & BitToLong04 = 2 * BitToLong04 + t(19) - asc0
& & BitToLong04 = 2 * BitToLong04 + t(20) - asc0
& & BitToLong04 = 2 * BitToLong04 + t(21) - asc0
& & BitToLong04 = 2 * BitToLong04 + t(22) - asc0
& & BitToLong04 = 2 * BitToLong04 + t(23) - asc0
& & BitToLong04 = 2 * BitToLong04 + t(24) - asc0
& & BitToLong04 = 2 * BitToLong04 + t(25) - asc0
& & BitToLong04 = 2 * BitToLong04 + t(26) - asc0
& & BitToLong04 = 2 * BitToLong04 + t(27) - asc0
& & BitToLong04 = 2 * BitToLong04 + t(28) - asc0
& & BitToLong04 = 2 * BitToLong04 + t(29) - asc0
& & BitToLong04 = 2 * BitToLong04 + t(30) - asc0
& & BitToLong04 = t(31) - asc0 + 2 * BitToLong04
& & If t(0) && asc0 Then BitToLong04 = BitToLong04 Or &H
End Function
这不是我的代码,=会上我的代码,再给我点个赞.我的意思是挑战他的速度.
静等大神们过招
静等大神们过招
我是业余玩玩, 凑个热闹{:soso_e121:}
搞了半天, 由于那个德国人已经进行多版 的优化. 超过他不容易
'二进制 转 十进制.
'1.仅作对比使用.
'2.仅32位定长的二进制字符串.
Function BinToDecV6(BinString As String) As Long
& & If LenB(BinString) && 64& Then Exit Function
& &
& & Static saiShare() As Integer
& & Static sudtShare As UDT_SafeArray1D
& & '//1.初始化
& & With sudtShare
& && &&&If .cDims Then& && &'为了速度, 不采用 【If .cDims = 0 Then】, 因为条件判定式为 boolean = short int.
& && &&&Else
& && && && &'初始化数组
& && && && &.cDims = 1
& && && && &.cbElements = 2
& && && && &.fFeatures = FADF_AUTO Or FADF_FIXEDSIZE
& && && && &.clocks = 1& &&&'防止 VB 在卸载或中止时销毁, 因为描述符为手动栈区分配
& && && && &.cElements = 32& && && && &'元素数量
& && && && &PtrArr(saiShare) = VarPtr(sudtShare)& & '数组变量赋值(描述符的首地址)
& && && && &'初始化数据表
& && && && &Static salDate1(0 To 31) As Long
& && && && &Dim i As Long
& && && && &For i = 0 To 31
& && && && && & salDate1(i) = ShL(1, i)
& && && && &Next
& && &&&End If
& && &&&.pvData = StrPtr(BinString)& & '联接字符串数据
& && &&&
& && &&&'//2.转换数据
& && &&&If saiShare(0) And &H1 Then BinToDecV6 = salDate1(31)
& && &&&If saiShare(1) And &H1 Then BinToDecV6 = BinToDecV6 Or salDate1(30)
& && &&&If saiShare(2) And &H1 Then BinToDecV6 = BinToDecV6 Or salDate1(29)
& && &&&If saiShare(3) And &H1 Then BinToDecV6 = BinToDecV6 Or salDate1(28)
& && &&&If saiShare(4) And &H1 Then BinToDecV6 = BinToDecV6 Or salDate1(27)
& && &&&If saiShare(5) And &H1 Then BinToDecV6 = BinToDecV6 Or salDate1(26)
& && &&&If saiShare(6) And &H1 Then BinToDecV6 = BinToDecV6 Or salDate1(25)
& && &&&If saiShare(7) And &H1 Then BinToDecV6 = BinToDecV6 Or salDate1(24)
& && &&&If saiShare(8) And &H1 Then BinToDecV6 = BinToDecV6 Or salDate1(23)
& && &&&If saiShare(9) And &H1 Then BinToDecV6 = BinToDecV6 Or salDate1(22)
& && &&&If saiShare(10) And &H1 Then BinToDecV6 = BinToDecV6 Or salDate1(21)
& && &&&If saiShare(11) And &H1 Then BinToDecV6 = BinToDecV6 Or salDate1(20)
& && &&&If saiShare(12) And &H1 Then BinToDecV6 = BinToDecV6 Or salDate1(19)
& && &&&If saiShare(13) And &H1 Then BinToDecV6 = BinToDecV6 Or salDate1(18)
& && &&&If saiShare(14) And &H1 Then BinToDecV6 = BinToDecV6 Or salDate1(17)
& && &&&If saiShare(15) And &H1 Then BinToDecV6 = BinToDecV6 Or salDate1(16)
& && &&&If saiShare(16) And &H1 Then BinToDecV6 = BinToDecV6 Or salDate1(15)
& && &&&If saiShare(17) And &H1 Then BinToDecV6 = BinToDecV6 Or salDate1(14)
& && &&&If saiShare(18) And &H1 Then BinToDecV6 = BinToDecV6 Or salDate1(13)
& && &&&If saiShare(19) And &H1 Then BinToDecV6 = BinToDecV6 Or salDate1(12)
& && &&&If saiShare(20) And &H1 Then BinToDecV6 = BinToDecV6 Or salDate1(11)
& && &&&If saiShare(21) And &H1 Then BinToDecV6 = BinToDecV6 Or salDate1(10)
& && &&&If saiShare(22) And &H1 Then BinToDecV6 = BinToDecV6 Or salDate1(9)
& && &&&If saiShare(23) And &H1 Then BinToDecV6 = BinToDecV6 Or salDate1(8)
& && &&&If saiShare(24) And &H1 Then BinToDecV6 = BinToDecV6 Or salDate1(7)
& && &&&If saiShare(25) And &H1 Then BinToDecV6 = BinToDecV6 Or salDate1(6)
& && &&&If saiShare(26) And &H1 Then BinToDecV6 = BinToDecV6 Or salDate1(5)
& && &&&If saiShare(27) And &H1 Then BinToDecV6 = BinToDecV6 Or salDate1(4)
& && &&&If saiShare(28) And &H1 Then BinToDecV6 = BinToDecV6 Or salDate1(3)
& && &&&If saiShare(29) And &H1 Then BinToDecV6 = BinToDecV6 Or salDate1(2)
& && &&&If saiShare(30) And &H1 Then BinToDecV6 = BinToDecV6 Or salDate1(1)
& && &&&If saiShare(31) And &H1 Then BinToDecV6 = BinToDecV6 Or salDate1(0)
& && &&&
& && &&&'//3.清理工作
& && &&&.pvData = 0&& & '断开联接
& & End With
& &
End Function
复制代码
比德国人的快了14.23%
本帖子中包含更多资源
才可以下载或查看，没有帐号？
又简化了一个
速度更快, 这个应该是VB下的极限版本了. 即使用C写估计也就这样了
Function BinToDecV62(BinString As String) As Long
& & Static saiShare() As Integer, sudtShare As UDT_SafeArray1D
& & '//1.初始化
& & If LenB(BinString) && 64& Then Exit Function
& & With sudtShare
& && &&&If .cDims Then& && &'为了速度, 不采用 【If .cDims = 0 Then】, 因为条件判定式为 boolean = short int.
& && &&&Else
& && && && &'初始化数组
& && && && &.cDims = 1
& && && && &.cbElements = 2
& && && && &.fFeatures = FADF_AUTO Or FADF_FIXEDSIZE
& && && && &.clocks = 1& &&&'防止 VB 在卸载或中止时销毁, 因为描述符为手动栈区分配
& && && && &.cElements = 32& && && && &'元素数量
& && && && &PtrArr(saiShare) = VarPtr(sudtShare)& & '数组变量赋值(描述符的首地址)
& && &&&End If
& && &&&.pvData = StrPtr(BinString)& & '联结字符串数据
& && &&&'//2.转换数据
& && &&&If saiShare(0) And &H1 Then BinToDecV62 = &H
& && &&&If saiShare(1) And &H1 Then BinToDecV62 = BinToDecV62 Or &H
& && &&&If saiShare(2) And &H1 Then BinToDecV62 = BinToDecV62 Or &H
& && &&&If saiShare(3) And &H1 Then BinToDecV62 = BinToDecV62 Or &H
& && &&&If saiShare(4) And &H1 Then BinToDecV62 = BinToDecV62 Or &H8000000
& && &&&If saiShare(5) And &H1 Then BinToDecV62 = BinToDecV62 Or &H4000000
& && &&&If saiShare(6) And &H1 Then BinToDecV62 = BinToDecV62 Or &H2000000
& && &&&If saiShare(7) And &H1 Then BinToDecV62 = BinToDecV62 Or &H1000000
& && &&&If saiShare(8) And &H1 Then BinToDecV62 = BinToDecV62 Or &H800000
& && &&&If saiShare(9) And &H1 Then BinToDecV62 = BinToDecV62 Or &H400000
& && &&&If saiShare(10) And &H1 Then BinToDecV62 = BinToDecV62 Or &H200000
& && &&&If saiShare(11) And &H1 Then BinToDecV62 = BinToDecV62 Or &H100000
& && &&&If saiShare(12) And &H1 Then BinToDecV62 = BinToDecV62 Or &H80000
& && &&&If saiShare(13) And &H1 Then BinToDecV62 = BinToDecV62 Or &H40000
& && &&&If saiShare(14) And &H1 Then BinToDecV62 = BinToDecV62 Or &H20000
& && &&&If saiShare(15) And &H1 Then BinToDecV62 = BinToDecV62 Or &H10000
& && &&&If saiShare(16) And &H1 Then BinToDecV62 = BinToDecV62 Or &H8000&
& && &&&If saiShare(17) And &H1 Then BinToDecV62 = BinToDecV62 Or &H4000&
& && &&&If saiShare(18) And &H1 Then BinToDecV62 = BinToDecV62 Or &H2000&
& && &&&If saiShare(19) And &H1 Then BinToDecV62 = BinToDecV62 Or &H1000&
& && &&&If saiShare(20) And &H1 Then BinToDecV62 = BinToDecV62 Or &H800&
& && &&&If saiShare(21) And &H1 Then BinToDecV62 = BinToDecV62 Or &H400&
& && &&&If saiShare(22) And &H1 Then BinToDecV62 = BinToDecV62 Or &H200&
& && &&&If saiShare(23) And &H1 Then BinToDecV62 = BinToDecV62 Or &H100&
& && &&&If saiShare(24) And &H1 Then BinToDecV62 = BinToDecV62 Or &H80&
& && &&&If saiShare(25) And &H1 Then BinToDecV62 = BinToDecV62 Or &H40&
& && &&&If saiShare(26) And &H1 Then BinToDecV62 = BinToDecV62 Or &H20&
& && &&&If saiShare(27) And &H1 Then BinToDecV62 = BinToDecV62 Or &H10&
& && &&&If saiShare(28) And &H1 Then BinToDecV62 = BinToDecV62 Or &H8&
& && &&&If saiShare(29) And &H1 Then BinToDecV62 = BinToDecV62 Or &H4&
& && &&&If saiShare(30) And &H1 Then BinToDecV62 = BinToDecV62 Or &H2&
& && &&&If saiShare(31) And &H1 Then BinToDecV62 = BinToDecV62 Or &H1&
& && &&&'//3.清理工作
& && &&&.pvData = 0&& & '断开联结
& & End With
End Function复制代码
测试结果如下, 与2楼的BitToLong04 相比, 速度竟然提升了33.87%.
PS:把自己以前写的二进制转换十进制代码 作了一下对比. 速度是之前的25倍之多
本帖子中包含更多资源
才可以下载或查看，没有帐号？
站长推荐 /6
即日起至日 Office中国全线产品优惠大促销
报名 Access中级 高级 顶级培训 将享有更多优惠，最高优惠达3800元
Access通用开发平台企业版，支持SQLServer后台
优惠价3500元/套
美女MVP教你轻松学习Excel VBA 优惠至88元
Excel O啦插件 优惠至88元
Excel 微信助手 8折优惠
Access超级经典源码剖析 脑图+源码+视频 组合装, 原价2217元,折合优惠价 1280元
更多的优惠请猛戳查看
1.让初学者了解Excel VBA的强大之处，学习VBA的使用
2.使更多Excel使用者会利用VBA来简化工作，减少重复操作
3.让Excel开发者能够快速地使用VBA进行开发设计，做出满足要求的应用
企业中正在实际使用的企业级进销存管理系统
用户可自定义的 拖拉式 流程图设计（而非普通的固死的流程图）
流程清晰 功能齐全 操作方便
VBA开发神器第一版发布-平台插件VBA伴侣
一款VBA编写帮助工具，让你在最短的时间编写质量最高的代码。VBA从此不再害怕！！
1.通用代码库，支持官方代码片段和官方函数
2.快捷添加到个人函数库，方便一键使用
3.函数提交支持参数设置，自动识别过程函数
4.自动生成作者和函数相关，快速填写注释
5.遇到陌生代码，可快速查找
6.代码美化整理
由Office中国出品，让你使用Excel更方便，更高效，更快捷！
搞定工作，不用加班，早点下班不再是梦！
包含功能个数：5大功能模块，近100个Excel功能
Access VBA 开发在线帮助指南手册
1.Access 2010 在线帮助教程手册
2.Access Jet Sql 语法在线帮助
3.微软 API 编程开发手册
4.ADO程序员参考在线帮助手册
5.DAO程序员参考在线帮助手册
6.Access中国在线培训中心
7.Access通用智能开发平台培训教程
8.Excel在线帮助手册大全
Powered byvba内把10进制数转化为指定位数的16进制数比如说我想把10进制的【0】写为8位的16进制【】,
代码如下Sub test()Dim i As IntegerDim str8Hex As Stringi = 10MsgBox istr8Hex = Right("0000000" & Hex(i),8)MsgBox str8HexEnd Sub
为您推荐：
其他类似问题
扫描下载二维码}