Office中國(guó)論壇/Access中國(guó)論壇

 找回密碼
 注冊(cè)

QQ登錄

只需一步，快速開(kāi)始

返回列表 發(fā)新帖
查看: 2410|回復(fù): 5
打印 上一主題 下一主題

[模塊/函數(shù)] HackVBASpeed 之進(jìn)制轉(zhuǎn)換,之二進(jìn)制轉(zhuǎn)十六進(jìn)制. 極限速度

[復(fù)制鏈接]
跳轉(zhuǎn)到指定樓層
1#
發(fā)表于 2015-8-25 18:53:20 | 只看該作者 回帖獎(jiǎng)勵(lì) |倒序?yàn)g覽 |閱讀模式
本帖最后由 wang1999 于 2015-8-25 19:05 編輯

這是我剛開(kāi)始學(xué)VBA時(shí)寫的, 結(jié)構(gòu)清晰, 看著清爽. 還算不錯(cuò). 只是性能方面，現(xiàn)在看來(lái)不敢恭維。
  1. Public Function BinToHex(ByVal Bin As String) As String
  2.     Dim i As Long
  3.     i = Len(Bin) Mod 4
  4.     If i <> 0 Then  '按每組4個(gè)二進(jìn)制字符配齊
  5.         Bin = String(4 - i, "0") & Bin
  6.     End If
  7.     For i = 1 To Len(Bin) Step 4
  8.         Select Case Mid$(Bin, i, 4)
  9.         Case "0000": BinToHex = BinToHex & "0"
  10.         Case "0001": BinToHex = BinToHex & "1"
  11.         Case "0010": BinToHex = BinToHex & "2"
  12.         Case "0011": BinToHex = BinToHex & "3"
  13.         Case "0100": BinToHex = BinToHex & "4"
  14.         Case "0101": BinToHex = BinToHex & "5"
  15.         Case "0110": BinToHex = BinToHex & "6"
  16.         Case "0111": BinToHex = BinToHex & "7"
  17.         Case "1000": BinToHex = BinToHex & "8"
  18.         Case "1001": BinToHex = BinToHex & "9"
  19.         Case "1010": BinToHex = BinToHex & "A"
  20.         Case "1011": BinToHex = BinToHex & "B"
  21.         Case "1100": BinToHex = BinToHex & "C"
  22.         Case "1101": BinToHex = BinToHex & "D"
  23.         Case "1110": BinToHex = BinToHex & "E"
  24.         Case "1111": BinToHex = BinToHex & "F"
  25.         End Select
  26.     Next
  27. End Function
復(fù)制代碼


下面這個(gè)是我的VBA最終版,帶錯(cuò)誤檢查, 帶占位符的. 測(cè)后速度 191967.953

Public Function BinToHexV5(BinString As String, Optional ByVal Places As Long = 8) As String
    Dim i As Long, lLen As Long
    Static sacurBinStr(1 To 8) As Currency, aiRetStr(1 To 8) As Integer, sai0Str(1 To 8) As Integer
   
    '//1.初始化
    '初始化字符串=8個(gè)"0"    '判斷語(yǔ)句不作比較時(shí), Integer 比 long 要快
    If sai0Str(1) Then Else sai0Str(1) = 48: sai0Str(2) = 48: sai0Str(3) = 48: sai0Str(4) = 48: sai0Str(5) = 48: sai0Str(6) = 48: sai0Str(7) = 48: sai0Str(8) = 48
    CopyMem16 aiRetStr(1), sai0Str(1)
    '參數(shù)檢查
    lLen = LenB(BinString)      '后面復(fù)制時(shí)單位為字節(jié), 所以為 LenB
    If lLen > 64& Then Err.Raise erCom + 3, "BinToHex", "參數(shù)過(guò)長(zhǎng)": Exit Function
    If lLen = 0& Then Err.Raise erCom + 4, "BinToHex", "空參數(shù)": Exit Function
    i = (lLen + 7&) \ 8&    '取得 BinString 的16進(jìn)制最高位的位置
    If Places < 1& Or Places > 8& Then Places = i      '超出范圍時(shí), 重定占位長(zhǎng)度
    '復(fù)制 參數(shù)(BinString)到數(shù)組; VarPtr(sacurBinStr(8)) - lLen + 8: 字節(jié)對(duì)齊;
    sacurBinStr(9 - i) = 1351100504368.7472@   '="0000", 將 BinString 按4位一組在高位補(bǔ)齊前導(dǎo)"0"字符串
    MoveMemoryPtr2Ptr VarPtr(sacurBinStr(8)) - lLen + 8, BinString, lLen
   
    '//2.轉(zhuǎn)換數(shù)據(jù). 遍歷字符串, 從高位開(kāi)始轉(zhuǎn)換;     '處理 Places, 如果設(shè)置長(zhǎng)度過(guò)小或過(guò)大, 則輸出實(shí)際位數(shù)
    For i = 9 - i To 8
        Select Case sacurBinStr(i)
        Case 1351100504368.7472@    '0000
            aiRetStr(i) = 48   ' "0"
        Case 1379248002039.8128@    '0001
            aiRetStr(i) = 49   ' "1"
        Case 1351100933865.4768@    '0010
            aiRetStr(i) = 50   ' "2"
        Case 1379248431536.5424@    '0011
            aiRetStr(i) = 51   ' "3"
        Case 1351100504375.3008@    '0100
            aiRetStr(i) = 52   ' "4"
        Case 1379248002046.3664@    '0101
            aiRetStr(i) = 53   ' "5"
        Case 1351100933872.0304@    '0110
            aiRetStr(i) = 54   ' "6"
        Case 1379248431543.096@    '0111
            aiRetStr(i) = 55   ' "7"
        Case 1351100504368.7473@    '1000
            aiRetStr(i) = 56   ' "8"
        Case 1379248002039.8129@    '1001
            aiRetStr(i) = 57   ' "9"
        Case 1351100933865.4769@    '1010
            aiRetStr(i) = 65   ' "A"
        Case 1379248431536.5425@    '1011
            aiRetStr(i) = 66   ' "B"
        Case 1351100504375.3009@    '1100
            aiRetStr(i) = 67   ' "C"
        Case 1379248002046.3665@    '1101
            aiRetStr(i) = 68   ' "D"
        Case 1351100933872.0305@    '1110
            aiRetStr(i) = 69   ' "E"
        Case 1379248431543.0961@    '1111
            aiRetStr(i) = 70   ' "F"
        Case Else
            Err.Raise erCom + 5, "BinToHexV5", "類型不符合":  Exit Function
        End Select
    Next
    '返回?cái)?shù)據(jù)
    BinToHexV5 = SysAllocStringLen(aiRetStr(1), Places)
End Function


分享到:  QQ好友和群QQ好友和群 QQ空間QQ空間 騰訊微博騰訊微博 騰訊朋友騰訊朋友
收藏收藏 分享分享 分享淘帖 訂閱訂閱
2#
 樓主| 發(fā)表于 2015-8-25 19:11:11 | 只看該作者
這個(gè)是重寫, 速度十萬(wàn)次 172686.836 微秒,  是一樓的5倍速
不含調(diào)用開(kāi)銷為:
843,929
172,077
671,852
0.20389965
4.90437329
  1. Public Function BinToHexV3(BinString As String) As String
  2.     Dim i As Long, lLen As Long
  3.     Static sacurData(7) As Currency, sData(7) As Integer
  4.    
  5.     '//1.初始化
  6.     lLen = LenB(BinString)
  7.     If lLen <= 64& Then Else Err.Raise erCom + 3, "BinToDecN1", "參數(shù)過(guò)長(zhǎng)": Exit Function
  8.     If lLen <> 0& Then Else Err.Raise erCom + 4, "BinToDecN1", "空參數(shù)": Exit Function
  9.     '復(fù)制二進(jìn)制字符串到數(shù)組; (64& - lLen) Mod 8&: 字節(jié)對(duì)齊
  10.     sacurData(0) = 1351100504368.7472@      '字符串: 0000
  11.     MoveMemoryPtr2Ptr VarPtr(sacurData(0)) + (64& - lLen) Mod 8&, BinString, lLen
  12.    
  13.     '//2.轉(zhuǎn)換數(shù)據(jù). 遍歷字符串, 從未尾(低位)開(kāi)始轉(zhuǎn)換
  14.     lLen = (lLen - 2) \ 8
  15.     For i = lLen To 0 Step -1
  16.         Select Case sacurData(i)
  17.         Case 1351100504368.7472@    '0000
  18.             sData(i) = 48   ' "0"
  19.         Case 1379248002039.8128@    '0001
  20.             sData(i) = 49   ' "1"
  21.         Case 1351100933865.4768@    '0010
  22.             sData(i) = 50   ' "2"
  23.         Case 1379248431536.5424@    '0011
  24.             sData(i) = 51   ' "3"
  25.         Case 1351100504375.3008@    '0100
  26.             sData(i) = 52   ' "4"
  27.         Case 1379248002046.3664@    '0101
  28.             sData(i) = 53   ' "5"
  29.         Case 1351100933872.0304@    '0110
  30.             sData(i) = 54   ' "6"
  31.         Case 1379248431543.096@    '0111
  32.             sData(i) = 55   ' "7"
  33.         Case 1351100504368.7473@    '1000
  34.             sData(i) = 56   ' "8"
  35.         Case 1379248002039.8129@    '1001
  36.             sData(i) = 57   ' "9"
  37.         Case 1351100933865.4769@    '1010
  38.             sData(i) = 65   ' "A"
  39.         Case 1379248431536.5425@    '1011
  40.             sData(i) = 66   ' "B"
  41.         Case 1351100504375.3009@    '1100
  42.             sData(i) = 67   ' "C"
  43.         Case 1379248002046.3665@    '1101
  44.             sData(i) = 68   ' "D"
  45.         Case 1351100933872.0305@    '1110
  46.             sData(i) = 69   ' "E"
  47.         Case 1379248431543.0961@    '1111
  48.             sData(i) = 70   ' "F"
  49.         Case Else:
  50.             Debug.Assert False  '錯(cuò)誤
  51.         End Select
  52.     Next
  53.    
  54.     BinToHexV3 = SysAllocStringByteLen(ByVal SafeArrayDataPtr(sData), (lLen + 1) * 2)
  55. End Function
復(fù)制代碼
3#
 樓主| 發(fā)表于 2015-8-25 19:30:44 | 只看該作者
再后來(lái)又用C重寫了一個(gè)API. TLB調(diào)用,
速度對(duì)比一樓發(fā)現(xiàn)提升了70倍.
數(shù)據(jù)如下
測(cè)試代碼開(kāi)銷函數(shù)開(kāi)銷　實(shí)際開(kāi)銷　　時(shí)間比　
VBA
C
VBA
C
VBA
C
差值
函數(shù)1/函數(shù)2
函數(shù)2/函數(shù)1
610
610
844,539
12,609
843,929
11,999
831,930
0.01421772
70.334764

VBA下執(zhí)行轉(zhuǎn)換僅0.012微秒

后來(lái)反匯編跟進(jìn), 原來(lái)VBA中一句代碼的執(zhí)行,后臺(tái)VBE執(zhí)行的指令尼瑪有上百條. 怪不得VBA這么方便. VBE在后臺(tái)辛勤把活干.

不過(guò)也犧牲了性能. 如果都帶這樣提升近百倍, 你們說(shuō)這每年電費(fèi)要省多少.(尤其現(xiàn)在好多網(wǎng)頁(yè)還有手機(jī)上的APP, 性能方面做得真垃圾, 我估計(jì)他們都是利用現(xiàn)成的直接拼裝)


點(diǎn)擊這里給我發(fā)消息
4#
發(fā)表于 2015-8-26 10:19:15 | 只看該作者
贊一個(gè)！很好的對(duì)比文章

點(diǎn)擊這里給我發(fā)消息
5#
發(fā)表于 2015-8-26 12:09:44 | 只看該作者
學(xué)習(xí)！
回復(fù)

使用道具 舉報(bào)

6#
發(fā)表于 2015-8-26 16:20:50 | 只看該作者
學(xué)習(xí)一下再說(shuō)
您需要登錄后才可以回帖 登錄 | 注冊(cè)

本版積分規(guī)則

QQ|站長(zhǎng)郵箱|小黑屋|手機(jī)版|Office中國(guó)/Access中國(guó) ( 粵ICP備10043721號(hào)-1 )  

GMT+8, 2024-10-23 08:40 , Processed in 0.100981 second(s), 29 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回復(fù) 返回頂部 返回列表