VBAでミリ秒やマイクロ秒の計測を行う

現在日時をミリ秒で取得するには

このページでは、処理経過時間を計測する方法について説明しています。

そうではなく、現在日時をミリ秒まで取得したい場合があります。

その方法について「VBAで現在日時をミリ秒単位で取得する」をご参照ください。

ミリ秒とマイクロ秒を正確に計測するには

現在時刻ではなく、VBAの処理の開始と終了までに掛かった時間をミリ秒やマイクロ秒で正確に計測したいことがあります。

ミリ秒もマイクロ秒もVBAの機能だけでは実現できないため、Windows APIを利用して実現します。

なお、ミリ秒は1000分の1秒で、マイクロ秒は100万分の1秒のことです。

1000倍の差があります。

ここでは使いませんがナノ秒は10億分の1秒で、マイクロ秒の1000分の1になります。

ミリ秒の取得にはGetTickCount関数やtimeGetTime関数でも可能ですが、精度が悪いためここでは使いません。

精度としては一番良いQueryPerformanceFrequency関数とQueryPerformanceCounter関数を使います。

これらの関数についてはソースコード内で説明します。

なお、このQueryPerformanceFrequency関数とQueryPerformanceCounter関数では時刻ではなくシステムが起動してから関数を実行するまでの経過時間を取得します。

マイクロ秒の計測

マイクロ秒の計測では以下の関数を用います。取得する際の単位は秒です。

1行目と2行目のDeclareはモジュール内にある最初の関数より上に記述してください。

Declare Function QueryPerformanceFrequency Lib "kernel32" (frequency As Double) As Long
Declare Function QueryPerformanceCounter Lib "kernel32" (procTime As Double) As Long

Function GetMicroSecond() As Double
    Dim procTime            As Double       '// 高分解能パフォーマンスカウンタ値（システム起動からの加算値）
    Dim frequency           As Double       '// 高分解能パフォーマンスカウンタの周波数（１秒間に増えるカウントの数）
    Dim ret                 As Double       '// 計測結果
    
    '// 計測時刻を0で初期化
    GetMicroSecond = 0

    '// 更新頻度を取得
    Call QueryPerformanceFrequency(frequency)

    '// 処理時刻を取得
    Call QueryPerformanceCounter(procTime)

    '// カウンタ値を１秒間のカウント増加数で割り、正確な時刻を算出
    GetMicroSecond = procTime / frequency
End Function

Declare Function QueryPerformanceFrequency Lib "kernel32" (frequency As Double) As Long

Declare Function QueryPerformanceCounter Lib "kernel32" (procTime As Double) As Long

Function GetMicroSecond() As Double

Dim procTime As Double '// 高分解能パフォーマンスカウンタ値（システム起動からの加算値）

Dim frequency As Double '// 高分解能パフォーマンスカウンタの周波数（１秒間に増えるカウントの数）

Dim ret As Double '// 計測結果

'// 計測時刻を0で初期化

GetMicroSecond = 0

'// 更新頻度を取得

Call QueryPerformanceFrequency(frequency)

'// 処理時刻を取得

Call QueryPerformanceCounter(procTime)

'// カウンタ値を１秒間のカウント増加数で割り、正確な時刻を算出

GetMicroSecond = procTime / frequency

End Function

ソースコードの説明

GetMicroSecond関数はシステム起動後の経過時間をマイクロ秒の精度で算出する関数です。

これを２回呼び出して、その差から処理時間を計測することが出来ます。

QueryPerformanceCounter関数はシステムが起動してからの経過時間を取得する関数で、QueryPerformanceFrequency関数はCPUのクロック周波数より１秒間に増えるカウント数を取得する関数です。

QueryPerformanceFrequency関数の結果はシステムが起動してからは変わらないため、１度取得してしまえばあとは使い回しができます。これについては改善点を後述しています。

QueryPerformanceCounter関数での取得値を、QueryPerformanceFrequency関数の取得値で割ると、システム起動後の経過時間が高精度で求められます。

精度はCPUの性能に依存するため、どれだけの精度が出るのかはPCごとに異なります。

高分解能パフォーマンスカウンタ値変数の型について

5行目と6行目の変数定義ではDouble型を利用しています。

これには理由があります。

ネット上にあるマイクロ秒の取得方法では、高分解能パフォーマンスカウンタ値用の変数の型に、通貨型であるCurrency型を使っているものがとても多いですが、これには問題があります。

なぜCurrency型を使っているのかと言うと、おそらくマイクロソフトがサンプル（https://msdn.microsoft.com/ja-jp/library/aa730921.aspx）で出しているコードがそう書いてあるからだと思います。

何が問題なのかと言うと、型の精度が関数の結果と異なる点です。

16行目のQueryPerformanceCounter関数の引数はLARGE_INTEGER型という構造体になっており、実際のカウンタ値を保持する変数はLONGLONG型という、-9,223,372,036,854,775,808 ～ 9,223,372,036,854,775,807 の値範囲の符号付き 64ビット(8バイト)数値の型です。

それに対してVBAのCurrency型は整数15桁と小数4桁として-922,337,203,685,477.5808 ～ 922,337,203,685,477,5807 の値範囲の8バイトです。

見た目の数値は似ていますが整数精度が異なります。

そのため、PCが起動してからの時間が長い場合に、QueryPerformanceCounter関数の結果がCurrency型の範囲を超える懸念があるため、その状況になった場合にCurrency型で正しく取得できるかには疑問が残ります。

そのことから制約がなるべく少ない方がよいと思われるため、LONGLONGと同じ8バイトのDouble型で実装しています。

Double型にはCurrency型のような精度制約はありません。

なお、Variant型でももちろんいいのですが、型変換による遅延が発生するため高精度を求める場合はVariant型を使うのは避けた方がいいでしょう。

ミリ秒の計測

ミリ秒の計測は、上で作成したマイクロ秒算出関数を使います。単位をミリ秒にしているだけです。

Function GetMilliSecond()
    GetMilliSecond = GetMicroSecond * 1000
End Function

Function GetMilliSecond()

GetMilliSecond = GetMicroSecond * 1000

End Function

利用方法

こんな感じで計測したい処理の前後で上記関数を呼び出して、計測後に差を算出することで処理時間を計測できます。

Sub GetMicroSecondTest()
    Dim milliStart As Double
    Dim microStart As Double
    Dim milliEnd As Double
    Dim microEnd As Double
    Dim milliDiff As Double
    Dim microDiff As Double
    Dim i
    Dim a
    
    '// 処理前の時間を取得
    milliStart = GetMilliSecond
    microStart = GetMicroSecond
    
    '// 計測対象の処理
    For i = 0 To 1000000
        a = CStr(i)
    Next
    
    '// 処理後の時間を取得
    milliEnd = GetMilliSecond
    microEnd = GetMicroSecond
    
    '// 処理前後の差を取得
    milliDiff = milliEnd - milliStart
    microDiff = microEnd - microStart
    
    Debug.Print microDiff & "秒 "; milliDiff & "ミリ秒"
End Sub

Sub GetMicroSecondTest()

Dim milliStart As Double

Dim microStart As Double

Dim milliEnd As Double

Dim microEnd As Double

Dim milliDiff As Double

Dim microDiff As Double

Dim i

Dim a

'// 処理前の時間を取得

milliStart = GetMilliSecond

microStart = GetMicroSecond

'// 計測対象の処理

For i = 0 To 1000000

a = CStr(i)

'// 処理後の時間を取得

milliEnd = GetMilliSecond

microEnd = GetMicroSecond

'// 処理前後の差を取得

milliDiff = milliEnd - milliStart

microDiff = microEnd - microStart

Debug.Print microDiff & "秒 "; milliDiff & "ミリ秒"

End Sub

ここで出力される秒とミリ秒ですが、実行すると誤差が出ます。

その理由は、そもそもこういうコードの書き方をすることは無いとは思いますが、12行目と13行目、そして、21行目と22行目で計測が行われており、そのズレが影響しています。

実際に使う場合は、マイクロ秒のみかミリ秒のみかに限定して取得する方がズレが出ずに済みます。

改善点

上でも書いているのですが、QueryPerformanceFrequency関数は１度呼び出してしまえば使い回しが出来るため、GetMicroSecond関数を呼ぶ度に実行されるのは無駄です。

そこで、以下のように１度呼び出した結果を引数で持つようにすると無駄は減ります。

Function GetMicroSecondEx(frequency As Double) As Double
    Dim procTime            As Double       '// 高分解能パフォーマンスカウンタ値（システム起動からの加算値）
    Dim ret                 As Double       '// 計測結果
    
    '// 計測時刻を0で初期化
    GetMicroSecondEx = 0

    '// 処理時刻を取得
    Call QueryPerformanceCounter(procTime)

    '// カウンタ値を１秒間のカウント増加数で割り、正確な時刻を算出
    GetMicroSecondEx = procTime / frequency
End Function

Function GetMilliSecondEx(frequency As Double)
    GetMilliSecondEx = GetMicroSecondEx(frequency) * 1000
End Function

Function GetMicroSecondEx(frequency As Double) As Double

Dim procTime As Double '// 高分解能パフォーマンスカウンタ値（システム起動からの加算値）

Dim ret As Double '// 計測結果

'// 計測時刻を0で初期化

GetMicroSecondEx = 0

'// 処理時刻を取得

Call QueryPerformanceCounter(procTime)

'// カウンタ値を１秒間のカウント増加数で割り、正確な時刻を算出

GetMicroSecondEx = procTime / frequency

End Function

Function GetMilliSecondEx(frequency As Double)

GetMilliSecondEx = GetMicroSecondEx(frequency) * 1000

End Function

改善後の利用例ですが、10行目に変数宣言、13行目で取得を１度を行い、あとはそれを使いまわしています。

Sub GetMicroSecondExTest()
    Dim milliStart As Double
    Dim microStart As Double
    Dim milliEnd As Double
    Dim microEnd As Double
    Dim milliDiff As Double
    Dim microDiff As Double
    Dim i
    Dim a
    Dim frequency           As Double       '// 高分解能パフォーマンスカウンタの周波数（１秒間に増えるカウントの数）
    
    '// 更新頻度を取得
    Call QueryPerformanceFrequency(frequency)
    
    '// 処理前の時間を取得
    milliStart = GetMilliSecondEx(frequency)
    microStart = GetMicroSecondEx(frequency)
    
    '// 計測対象の処理
    For i = 0 To 1000000
        a = CStr(i)
    Next
    
    '// 処理後の時間を取得
    milliEnd = GetMilliSecondEx(frequency)
    microEnd = GetMicroSecondEx(frequency)
    
    '// 処理前後の差を取得
    milliDiff = milliEnd - milliStart
    microDiff = microEnd - microStart
    
    Debug.Print microDiff & "秒 " & milliDiff & "ミリ秒"
End Sub

Sub GetMicroSecondExTest()

Dim milliStart As Double

Dim microStart As Double

Dim milliEnd As Double

Dim microEnd As Double

Dim milliDiff As Double

Dim microDiff As Double

Dim i

Dim a

Dim frequency As Double '// 高分解能パフォーマンスカウンタの周波数（１秒間に増えるカウントの数）

'// 更新頻度を取得

Call QueryPerformanceFrequency(frequency)

'// 処理前の時間を取得

milliStart = GetMilliSecondEx(frequency)

microStart = GetMicroSecondEx(frequency)

'// 計測対象の処理

For i = 0 To 1000000

a = CStr(i)

'// 処理後の時間を取得

milliEnd = GetMilliSecondEx(frequency)

microEnd = GetMicroSecondEx(frequency)

'// 処理前後の差を取得

milliDiff = milliEnd - milliStart

microDiff = microEnd - microStart

Debug.Print microDiff & "秒 " & milliDiff & "ミリ秒"

End Sub

現在日時をミリ秒で取得するには

ミリ秒とマイクロ秒を正確に計測するには

マイクロ秒の計測

ソースコードの説明

高分解能パフォーマンスカウンタ値変数の型について

ミリ秒の計測

利用方法

改善点

関連記事