VBAでWin32APIによる長時間計測

Tech

本記事はGeminiの出力をプロンプト工学で整理した業務ドラフト（未検証）です。

VBAにおけるWin32 API（QueryPerformanceCounter）を利用した高精度・長時間処理計測の実装と性能チューニング

1. 背景と要件

VBA（Excel, Access）による定型業務の自動化において、数秒から数時間に及ぶ長時間処理のボトルネック特定や性能比較は不可欠です。しかし、VBA標準の Timer 関数は、精度が秒単位であり、特に高速な処理の差分計測や、数時間レベルの長時間計測には向いていません（約24時間でリセットされるという制限もあります）。

実務レベルでの高精度な計測を実現するためには、Windows OSが提供する高分解能パフォーマンスカウンタ（High-Resolution Performance Counter: HRPC）へのアクセスが必要です。

要件:

  1. VBA標準機能および外部ライブラリを使用せず、Win32 APIのみで実装する。

  2. Office 64ビット環境に対応するため、PtrSafe を宣言する。

  3. 高精度タイマー（マイクロ秒オーダー）を実装し、長時間計測にも対応させる。

  4. ExcelとAccessの具体的な最適化手法（ScreenUpdating, 配列、DAO/ADO）の前後比較を計測する。

2. 設計：QueryPerformanceCounterの利用と64bit対応

高精度な計測には、Win32 APIの以下の2つの関数を使用します。

  1. QueryPerformanceFrequency (QPF): カウンタが1秒あたりにインクリメントされる回数（周波数 Hz）を取得します。この値はシステム起動後、通常固定です。

  2. QueryPerformanceCounter (QPC): 現在のカウンタ値（64ビット整数）を取得します。

経過時間（秒）は (QPC_End - QPC_Start) / QPF で計算されます。

64ビットデータ型の取り扱い

QPCおよびQPFは64ビット整数（Large Integer）を返します。VBAの標準 Long 型（32ビット）ではオーバーフローするため、64ビット値を安全に扱う必要があります。

最も一般的な解決策は、VBAの Currency 型（内部的に64ビット整数として扱われるが、小数点以下4桁固定の固定小数点数）を使用する手法です[4]。この方法を使用すると、ポインタ操作を複雑にせずに高精度カウンタを格納し、VBA内で演算処理を行うことが可能になります。

処理の流れ (Mermaid Flowchart)

長時間にわたる複雑なデータ処理の計測フローは以下のようになります。

graph TD
    A["開始: 計測対象プロシージャ呼び出し"] --> B{"API宣言と環境確認"};
    B -- 周波数取得 --> C["計測開始: QPC_Start"];
    C --> D1("チューニング前処理");
    D1 --> E1["計測終了1: QPC_End1"];
    E1 --> F1{"経過時間計算1: (End1-Start) / Hz"};
    F1 --> G("チューニング処理実施");
    G --> C;
    C --> D2("チューニング後処理");
    D2 --> E2["計測終了2: QPC_End2"];
    E2 --> F2{"経過時間計算2: (End2-Start) / Hz"};
    F2 --> H["結果表示: チューニング効果(秒)"];
    H --> I["終了"];

3. 実装：高精度タイマーモジュール

標準モジュール（例: mod_HighResTimer）に以下のAPI宣言とラッパー関数を記述します。

' // mod_HighResTimer.bas

#If VBA7 Then

    ' 64bit/32bit 環境対応 (Office 2010以降)
    Private Declare PtrSafe Function QueryPerformanceCounter Lib "kernel32" ( _
        lpPerformanceCount As Currency) As Long
    Private Declare PtrSafe Function QueryPerformanceFrequency Lib "kernel32" ( _
        lpFrequency As Currency) As Long
#Else

    ' 32bit 環境対応 (非推奨だが互換性のために残す)
    Private Declare Function QueryPerformanceCounter Lib "kernel32" ( _
        lpPerformanceCount As Currency) As Long
    Private Declare Function QueryPerformanceFrequency Lib "kernel32" ( _
        lpFrequency As Currency) As Long
#End If

' グローバル変数として周波数を保持し、何度もAPIを叩くのを避ける
Private g_lngFrequency As Currency
Private Const PRECISION_FACTOR As Double = 10000# ' Currency型調整係数

' ------------------------------------------------------------------
' 1. カウンタ周波数を取得 (初回起動時に一度だけ実行)
' ------------------------------------------------------------------
Private Function GetFrequency() As Currency
    If g_lngFrequency = 0 Then
        If QueryPerformanceFrequency(g_lngFrequency) = 0 Then
            ' 取得失敗時のエラー処理
            Err.Raise 5, "QueryPerformanceFrequency", "パフォーマンスカウンタの周波数取得に失敗しました。"
        End If
    End If
    GetFrequency = g_lngFrequency
End Function

' ------------------------------------------------------------------
' 2. 現在のカウンタ値を取得 (計測開始/終了に使用)
' ------------------------------------------------------------------
Public Function GetQPC() As Currency
    Dim lngCounter As Currency
    If QueryPerformanceCounter(lngCounter) = 0 Then
        Err.Raise 5, "QueryPerformanceCounter", "パフォーマンスカウンタの取得に失敗しました。"
    End If
    GetQPC = lngCounter
End Function

' ------------------------------------------------------------------
' 3. 経過時間を計算 (秒単位)
' StartTime/EndTime は GetQPC() の戻り値
' ------------------------------------------------------------------
Public Function CalculateElapsedTime(StartTime As Currency, EndTime As Currency) As Double
    Dim lngFreq As Currency
    lngFreq = GetFrequency()

    ' Currency型で受け取ったカウンタ値は、本来の値の10000倍になっている。
    ' これを周波数で割り、さらに10000で割って秒に変換する。
    ' 内部計算: (EndTime * 10000 - StartTime * 10000) / (Freq * 10000)
    ' 簡略化: (EndTime - StartTime) / Freq
    ' ※ Currency型同士の減算・除算はVBAが内部で調整するため、このままでよい

    CalculateElapsedTime = CDbl((EndTime - StartTime) / lngFreq)
End Function

4. 検証：Excelでの大量データ処理計測とチューニング

Excelで、数千行のセルに値を書き込む処理の高速化（配列利用）の効果を計測します。

' // 標準モジュール (例: mod_Main)

Sub Measure_ExcelPerformance()
    Const ROWS_COUNT As Long = 50000
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets(1)

    Dim tStart As Currency, tEnd As Currency
    Dim dTime1 As Double, dTime2 As Double

    Application.ScreenUpdating = False

    '--- 処理1: セル直接書き込み (チューニング前) ---
    tStart = GetQPC()

    Dim i As Long
    For i = 1 To ROWS_COUNT
        ws.Cells(i, 1).Value = "Value_" & i
    Next i

    tEnd = GetQPC()
    dTime1 = CalculateElapsedTime(tStart, tEnd)


    '--- 処理2: 配列による一括書き込み (チューニング後) ---
    ws.Columns(1).ClearContents ' リセット

    Dim vData(1 To ROWS_COUNT, 1 To 1) As Variant
    tStart = GetQPC()

    For i = 1 To ROWS_COUNT
        vData(i, 1) = "Value_" & i
    Next i

    ws.Cells(1, 2).Resize(ROWS_COUNT, 1).Value = vData ' 一括書き込み

    tEnd = GetQPC()
    dTime2 = CalculateElapsedTime(tStart, tEnd)

    Application.ScreenUpdating = True

    '--- 結果表示 ---
    Debug.Print "--- Excel 50,000行書き込み計測 ---"
    Debug.Print "1. セル直接書き込み (未チューニング): " & Format$(dTime1, "0.00000") & " 秒"
    Debug.Print "2. 配列バッファ一括書き込み (チューニング済): " & Format$(dTime2, "0.00000") & " 秒"
    Debug.Print "改善率: " & Format$((dTime1 / dTime2), "0.0") & " 倍"

End Sub

（想定される結果：処理1は数秒、処理2は数十ミリ秒となり、改善率は100倍以上になることが多い。）

5. 検証：AccessでのDAO処理計測と最適化

Accessで大量のレコードセットを操作する際の処理時間と、dbUseNoLocks の効果を計測します。

' // 標準モジュール (Access VBA)

Sub Measure_AccessPerformance()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim strSQL As String

    ' ここでは「T_TargetData」テーブルが存在すると仮定
    strSQL = "SELECT ID, DataField FROM T_TargetData WHERE DataField IS NULL;" 

    Set db = CurrentDb

    Dim tStart As Currency, tEnd As Currency
    Dim dTime1 As Double, dTime2 As Double
    Dim lngCount As Long

    '--- 処理1: デフォルトロックでループ処理 ---
    tStart = GetQPC()

    ' デフォルトロック (dbOpenDynaset)
    Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)

    If Not rs.EOF Then
        rs.MoveLast
        rs.MoveFirst
        Do While Not rs.EOF
            ' 何らかの更新処理をシミュレート
            lngCount = lngCount + 1
            rs.MoveNext
        Loop
    End If
    rs.Close

    tEnd = GetQPC()
    dTime1 = CalculateElapsedTime(tStart, tEnd)


    '--- 処理2: dbUseNoLocks オプションでループ処理 (チューニング後) ---
    lngCount = 0
    tStart = GetQPC()

    ' dbUseNoLocks (読み取り専用または一括処理に適したオプション)
    Set rs = db.OpenRecordset(strSQL, dbOpenDynaset, dbUseNoLocks)

    If Not rs.EOF Then
        rs.MoveLast
        rs.MoveFirst
        Do While Not rs.EOF
            lngCount = lngCount + 1
            rs.MoveNext
        Loop
    End If
    rs.Close

    tEnd = GetQPC()
    dTime2 = CalculateElapsedTime(tStart, tEnd)

    '--- 結果表示 ---
    Debug.Print "--- Access DAO レコードセット計測 (" & lngCount & "件) ---"
    Debug.Print "1. デフォルトロック (未チューニング): " & Format$(dTime1, "0.00000") & " 秒"
    Debug.Print "2. dbUseNoLocks 使用 (チューニング済): " & Format$(dTime2, "0.00000") & " 秒"
    Debug.Print "改善率 (主にロック待機時間の削減): " & Format$((dTime1 / dTime2), "0.00") & " 倍"

    Set rs = Nothing
    Set db = Nothing
End Sub

（注: dbUseNoLocks の効果は、ネットワーク越しや競合が多い環境で顕著になりますが、高精度タイマーにより僅かな改善でも検出可能になります。）

6. 運用、実行手順とロールバック

実行手順

  1. ExcelまたはAccessを開き、VBAエディタ（Alt + F11）を起動します。

  2. 「挿入」→「標準モジュール」を選択し、mod_HighResTimer と検証コード（Measure_ExcelPerformance または Measure_AccessPerformance）をそれぞれ貼り付けます。

  3. 検証コードを実行します（F5キー）。計測結果はイミディエイトウィンドウ（Ctrl + G）に出力されます。

ロールバック手順

  1. 作成した標準モジュール（mod_HighResTimer および mod_Main など）をプロジェクトから削除します。

  2. このAPIはOSレベルの標準機能であり、レジストリやシステムファイルへの変更は伴わないため、特別なロールバック作業は不要です。

7. 落とし穴と注意点

PtrSafeと64bit環境

Office 2010以降の64ビット環境では、API宣言に必ず PtrSafe を使用しなければなりません。これがないとコンパイルエラーまたは実行時エラーが発生します。また、64ビット値を格納するために LongPtr を使うことも可能ですが、VBA内部での演算が必要な場合は本実装のように Currency 型を使う方が便利です[2][4]。

精度とオーバーフロー

QueryPerformanceCounter は非常に高精度ですが、カウンタ値自体はシステムの連続稼働時間に比例して増加し続けます。64ビット値（約 $9 \times 10^{18}$）は非常に大きいため、通常の使用においてオーバーフローの心配はありませんが、計測開始と終了の間にシステムが再起動した場合、不正確な結果を返す可能性があります。長時間（数日間）連続稼働させるタスクの場合、必ず計測開始前にOS起動からの経過時間（GetTickCount64 など）も併せてチェックすることが推奨されます。

性能チューニングの効果

計測結果から、Excelでは Application.ScreenUpdating = False や配列バッファの使用が、処理時間を数桁短縮する最大の要因であることが分かります。Accessでは、トランザクションの適切な使用や、DAO/ADOでのカーソルタイプ/ロックオプション (dbUseNoLocks) の選択が処理時間に大きく影響します。高精度タイマーは、これらの微妙な最適化の効果を数値として明確に把握するために不可欠です。

ライセンス：本記事のテキスト/コードは特記なき限り CC BY 4.0 です。引用の際は出典URL（本ページ）を明記してください。
利用ポリシー もご参照ください。

コメント

タイトルとURLをコピーしました