|
QueryPerformanceCounterとQueryPerformanceFrequencyの使用例です。Subプロシージャ「prcInit」を実行するとA列から順番にF列までのセル背景色が上から変わります。QueryPerformanceCounterとQueryPerformanceFrequencyで取得した時刻を使っているA列～C列では指定したインターバルの結果が顕著に表れますが、GetTickCountを使ったD列～F列の結果は、インターバルを細かく指定してもあまり変化しません。
QueryPerformanceFrequencyで取得できる値は、CPUがどれぐらいの速度でカウントしているかを表す値で常に一定です。そのため、前処理（prcInit）で一度だけ値を取得すればOK。
実際に時間に変換しているのはFunctionプロシージャ「fncGetTimeCount」です。ここでは、QueryPerformanceCounterで取得した値（curFrequency）をQueryPerformanceFrequencyで取得した値（curFrequency）で割った結果に1000を掛け、1/1000秒単位の時間に変換しています。
Option Explicit
'CPUの実行速度
Dim curFrequency As Currency
Sub prcInit()
'CPUの実行速度を取得
Call QueryPerformanceFrequency(curFrequency)
'ワークシートの初期化
Range(Columns(1), Columns(6)).Delete
'QueryPerformanceCounter使用時(20/1000秒)
Call prcMain1(20, "A")
'QueryPerformanceCounter使用時(21/1000秒)
Call prcMain1(21, "B")
'QueryPerformanceCounter使用時(22/1000秒)
Call prcMain1(22, "C")
'GetTickCount使用時(20/1000秒)
Call prcMain2(20, "D")
'GetTickCount使用時(21/1000秒)
Call prcMain2(21, "E")
'GetTickCount使用時(22/1000秒)
Call prcMain2(22, "F")
End Sub
Sub prcMain1(lngInterval As Long, strColumns As String)
'QueryPerformanceCounterとQueryPerformanceFrequencyを使った例
Dim lngTime As Long
Dim lngCnt As Long
Dim lngLimit As Long
Dim i As Long
'初期化
lngCnt = 1
lngLimit = GetTickCount
'前回処理時刻の保存
lngTime = fncGetTimeCount()
Do Until GetTickCount - lngLimit >= 1000
'前回色を変えてからnミリ秒経過していれば
'指定列のセル背景色を上からランダムに変更
If fncGetTimeCount() - lngTime >= lngInterval Then
Range(strColumns & lngCnt).Interior.ColorIndex = Int(Rnd * 57)
lngCnt = lngCnt + 1
lngTime = fncGetTimeCount()
End If
Loop
End Sub
Function fncGetTimeCount() As Long
Dim curCount As Currency
'カウンターの取得
Call QueryPerformanceCounter(curCount)
'1/1000秒に変換
'Long型にセットすることで、小数部をカットしています
fncGetTimeCount = CLng(curCount * 1000 / curFrequency)
End Function
Sub prcMain2(lngInterval As Long, strColumns As String)
'GetTickCountを使った例
Dim lngTime As Long
Dim lngCnt As Long
Dim lngLimit As Long
Dim i As Long
'初期化
lngCnt = 1
lngLimit = GetTickCount()
'前回処理時刻の保存
lngTime = GetTickCount()
Do Until GetTickCount - lngLimit >= 1000
'前回色を変えてからnミリ秒経過していれば
'指定列のセル背景色を上からランダムに変更
If GetTickCount() - lngTime >= lngInterval Then
Range(strColumns & lngCnt).Interior.ColorIndex = Int(Rnd * 57)
lngCnt = lngCnt + 1
lngTime = GetTickCount()
End If
Loop
End Sub
|
※このエクセルマクロはワークシート内へ記述するマクロです。
標準モジュールへGetTickCount関数、QueryPerformanceFrequency関数、QueryPerformanceCounter関数を定義する必要があります。
|
|
|
※ 
※
※
へジャンプします。※は共著作品）