VBAでミリ秒以下の高精度で処理時間計測

gistfile1.vb

Option Compare Database
Option Explicit

Declare Function QueryPerformanceCounter Lib "Kernel32" _
                           (X As Currency) As Boolean
Declare Function QueryPerformanceFrequency Lib "Kernel32" _
                           (X As Currency) As Boolean
Dim Freq As Currency
Dim Overhead  As Currency
Dim Ctr1 As Currency, Ctr2 As Currency, Result As Currency

'ミリ秒以下の高精度で処理時間計測
Public Sub SWStart()
    If QueryPerformanceCounter(Ctr1) Then
        QueryPerformanceCounter Ctr2
        QueryPerformanceFrequency Freq
'        Debug.Print "QueryPerformanceCounter minimum resolution: 1/" & _
'                    Freq * 10000; " sec"
'        Debug.Print "API Overhead: "; (Ctr2 - Ctr1) / Freq * 1000; "ミリ秒"
        Overhead = Ctr2 - Ctr1
    Else
        Err.Raise 513, "StopwatchError", "High-resolution counter not supported."
    End If
    QueryPerformanceCounter Ctr1
End Sub

Public Sub SWStop()
    QueryPerformanceCounter Ctr2
    Result = (Ctr2 - Ctr1 - Overhead) / Freq * 1000
End Sub

Public Sub SWShow(Optional Caption As String)
    Debug.Print Caption & " " & Result
End Sub

gistfile2.vb

'使用例
Private Sub IntegerVSLong()
Dim i As Long, c As Long, A As Integer, B As Long
Const r = 100
 
    For c = 1 To 5
        Debug.Print c & "回目"
 
        SWStart
         
        For i = 1 To r
            A = A + i
        Next
         
        SWStop
        SWShow "Intrger加算："
     
        SWStart
         
        For i = 1 To r
            B = B + i
        Next i
         
        SWStop
        SWShow "Long   加算："
    Next
End Sub