vbaで、性能を調べるコード(ミリ秒単位の経過時間)

vbaで、性能を調べるためのコード。
(指定区間の実行時間をミリ秒単位で出力)

コード

標準モジュールに次のコードを実装する。
沢山ログを入れてしまって、ログがうるさいようなら、timestump_switchでログ出力を抑止できます。

Declare Function GetTickCount Lib "kernel32" () As Long

Private s_ts_start As Long
Private s_ts_switch As Boolean

Public Sub timestump_start()
    s_ts_switch = True
    s_ts_start = GetTickCount
End Sub

Public Sub timestump_print(Optional marker As String = "")
    If s_ts_switch = False Then
        Exit Sub
    End If
    Dim e As Long, t As Long
    e = GetTickCount
    t = e - s_ts_start
    Dim h As Integer, m As Integer, s As Integer, ms As Integer
    ms = t Mod 1000
    t = (t - ms) / 1000
    s = t Mod 60
    t = (t - s) / 60
    m = t Mod 60
    h = (t - m) / 60
    Dim msg As String
    msg = IIf(marker <> "", marker & ">> ", "") & _
            CStr(h) & ":" & CStr(m) & ":" & CStr(s) & "." & CStr(ms)
    Debug.Print msg
    s_ts_start = e
End Sub

Public Function timestump_switch(sw As Boolean) As Boolean
    timestump_switch = s_ts_switch
    s_ts_switch = sw
End Function

テストコード

簡単なテストコードです。
timestump_switchは使ってない。
実際に使う時は、timestump_print()の引数markerを指定しないと、どこの区間の時間か分からなくなる。

Private Sub tes_timestump()
    timestump_start
    Dim idx As Long
    For idx = 0 To 5000000
    Next
    Debug.Print Time: timestump_print
    Dim idx2 As Long
    For idx = 0 To 10000000
        For idx2 = 0 To 30
        Next
    Next
    Debug.Print Time: timestump_print "END!!!"
End Sub

実行結果

上記テストコードの実行結果。
（イミディエイトウィンドウに出力されます）

8:16:42 
0:0:0.297
8:16:47 
END!!!>> 0:0:5.781