Excel VBA 逆引き集 | マクロ実行時間計測

Excel VBA
スポンサーリンク

マクロ実行時間計測

動作が遅いと感じたら「どこで時間がかかっているか」を数値で掴むのが最短の改善ルートです。初心者でもすぐ使える計測テンプレートを用意し、重要ポイントを深掘りします。キーワードは Timer、精密計測（Windows API）、区間計測、チャンクの進捗、ログ連携です。

計測の考え方と設計方針

  • 目的:
    • 実行全体や各区間の所要時間を数値化し、ボトルネックを特定して対策につなげる。
  • 基本戦略:
    • 粗い計測（秒精度）: Timer を使い、開始時刻と終了時刻の差を取る。
    • 精密計測（ミリ秒以下）: Windows API（高分解能タイマー）で区間を詳細計測。
    • 区間計測（マイルストーン）: ステップごとに「開始→終了」を記録して、遅い場所を炙り出す。
    • チャンク計測: 20万行などの塊ごとに時間と件数を記録し、平均処理速度を把握。
  • 重要ポイント（深掘り）:
    • 「計測は軽い」ことが条件。 計測自体が重いと本末転倒。軽量な仕組みを選ぶ。
    • 「区間ラベル」を付ける。 後で見返して分かるように、何の工程かを記録する。
    • 「画面更新や再計算」は止める。 計測時に揺れを生む要因を抑えると精度が安定。

テンプレ1：最小の全体計測（Timer）

Sub MeasureTotal()
    Dim t0 As Double, t1 As Double
    t0 = Timer
    
    ' --- 本処理（例：配列で前後空白除去） ---
    Dim ws As Worksheet: Set ws = Worksheets("Input")
    Dim lastRow As Long: lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Dim data As Variant: data = ws.Range("A2:E" & lastRow).Value2
    
    Dim r As Long, c As Long
    For r = 1 To UBound(data, 1)
        For c = 1 To UBound(data, 2)
            If Not IsEmpty(data(r, c)) Then
                data(r, c) = Trim$(Replace(CStr(data(r, c)), ChrW(&H3000), " "))
            End If
        Next c
    Next r
    
    ws.Range("A2:E" & lastRow).Value2 = data
    ' --- 本処理ここまで ---
    
    t1 = Timer
    MsgBox "総処理時間: " & Format(t1 - t0, "0.00") & " 秒"
End Sub
VB
  • 重要ポイント:
    • 簡単・軽量: Timer は秒単位で十分に役に立つ。
    • 差分計測: Timer の差で全体時間を取得。日を跨ぐと値がリセットされる点に注意。

テンプレ2：区間計測ヘルパー（ステップ別に可視化）

' 計測ヘルパー（モジュールに配置）
Private mStart As Double

Public Sub TickStart()
    mStart = Timer
End Sub

Public Sub Tick(ByVal label As String)
    Dim dt As Double: dt = Timer - mStart
    Debug.Print Format(Now, "yyyy-mm-dd HH:NN:SS"), label, ":", Format(dt, "0.000"), "秒"
    mStart = Timer ' 次区間のために更新
End Sub

Sub MeasurePipeline()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    On Error GoTo Clean
    
    TickStart
    
    ' --- Step1 読み込み ---
    Dim ws As Worksheet: Set ws = Worksheets("Input")
    Dim lastRow As Long: lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Dim arr As Variant: arr = ws.Range("A2:E" & lastRow).Value2
    Tick "読み込み"
    
    ' --- Step2 クリーニング ---
    Dim i As Long
    For i = 1 To UBound(arr, 1)
        arr(i, 3) = ExtractDigits(CStr(arr(i, 3))) ' 電話番号
    Next
    Tick "クリーニング"
    
    ' --- Step3 書き戻し ---
    ws.Range("A2:E" & lastRow).Value2 = arr
    Tick "書き戻し"
    
Clean:
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

' 依存関数（簡易版）
Private Function ExtractDigits(ByVal s As String) As String
    Dim j As Long, ch As String, r As String
    For j = 1 To Len(s): ch = Mid$(s, j, 1): If ch Like "[0-9]" Then r = r & ch: Next
    ExtractDigits = r
End Function
VB
  • 重要ポイント:
    • 区間ラベル: 「読み込み」「クリーニング」「書き戻し」など、何に時間がかかったかが一目で分かる。
    • Debug.Print出力: Immediateウィンドウへ軽量に出す。必要ならログ基盤に統合。

テンプレ3：高分解能タイマー（QueryPerformanceCounter）

' 高分解能タイマー宣言（標準モジュール）
#If VBA7 Then
    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
    Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
    Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As Currency) As Long
#End If

Private mFreq As Currency, mStartQpc As Currency

Public Sub HiResStart()
    QueryPerformanceFrequency mFreq
    QueryPerformanceCounter mStartQpc
End Sub

Public Function HiResElapsedMs() As Double
    Dim nowQpc As Currency
    QueryPerformanceCounter nowQpc
    HiResElapsedMs = (nowQpc - mStartQpc) / mFreq * 1000#
End Function

Sub MeasureHiResExample()
    HiResStart
    ' --- 計測対象 ---
    Dim s As String, i As Long
    For i = 1 To 100000
        s = Replace("ＡＢＣ　１２３", ChrW(&H3000), " ")
    Next
    ' --- 計測対象ここまで ---
    Dim ms As Double: ms = HiResElapsedMs()
    MsgBox "高分解能計測: " & Format(ms, "0.0") & " ms"
End Sub
VB
  • 重要ポイント（深掘り）:
    • ミリ秒未満の精度: 文字列操作・アルゴリズム比較に有効。
    • VBA7対応宣言: 64bit/32bit両対応の宣言を用意しておく。
    • 対象を短く: 高分解能計測は短区間に向く。長時間は Timer の方が十分。

テンプレ4：チャンク処理の進捗＋速度計測

Sub MeasureChunkSpeed()
    Dim ws As Worksheet: Set ws = Worksheets("Big")
    Dim lastRow As Long: lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Dim chunk As Long: chunk = 200000
    Dim r1 As Long: r1 = 2
    Dim processed As Long: processed = 0
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Dim t0 As Double: t0 = Timer
    
    Do While r1 <= lastRow
        Dim r2 As Long: r2 = WorksheetFunction.Min(r1 + chunk - 1, lastRow)
        Dim arr As Variant: arr = ws.Range("A" & r1 & ":E" & r2).Value2
        
        HiResStart
        
        Dim i As Long
        For i = 1 To UBound(arr, 1)
            ' 例：電話番号の数字抽出
            arr(i, 3) = ExtractDigits(CStr(arr(i, 3)))
        Next
        
        ws.Range("A" & r1 & ":E" & r2).Value2 = arr
        
        processed = processed + (r2 - r1 + 1)
        Dim ms As Double: ms = HiResElapsedMs()
        Dim speed As Double: speed = (r2 - r1 + 1) / (ms / 1000#) ' 行/秒
        Debug.Print "Chunk " & r1 & "-" & r2 & ":", Format(ms, "0"), "ms", "|", Format(speed, "0"), "行/秒"
        
        Application.StatusBar = "進捗 " & processed & "/" & (lastRow - 1)
        r1 = r2 + 1
        DoEvents
    Loop
    
    Application.StatusBar = False
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
    Dim totalSec As Double: totalSec = Timer - t0
    MsgBox "総処理時間: " & Format(totalSec, "0.0") & " 秒 | 合計行数: " & processed
End Sub
VB
  • 重要ポイント:
    • 行/秒の可視化: 現場で「早くなったか」を即判断できる指標。
    • チャンク境界で DoEvents: 過剰な呼び出しは遅くなるので最小限に。
    • StatusBar併用: フォームを使わず軽量に進捗表示。

テンプレ5：ログ基盤との統合（計測ログ化）

' 事前に Logger.bas の LogInit/LogWrite を用意
Sub MeasureWithLog()
    LogInit LOG_INFO, True, "C:\temp\perf.log"
    LogWrite LOG_INFO, "処理開始"
    
    Dim t0 As Double: t0 = Timer
    HiResStart
    
    ' --- 対象処理 ---
    Dim ws As Worksheet: Set ws = Worksheets("Input")
    Dim lr As Long: lr = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Dim arr As Variant: arr = ws.Range("A2:E" & lr).Value2
    Dim i As Long
    For i = 1 To UBound(arr, 1)
        arr(i, 1) = Trim$(CStr(arr(i, 1)))
    Next
    ws.Range("A2:E" & lr).Value2 = arr
    ' --- 対象処理ここまで ---
    
    LogWrite LOG_INFO, "高分解能: " & Format(HiResElapsedMs(), "0") & " ms"
    LogWrite LOG_INFO, "総時間: " & Format(Timer - t0, "0.00") & " 秒"
    LogWrite LOG_INFO, "行数: " & (lr - 1)
    MsgBox "計測完了（perf.log参照）"
End Sub
VB
  • 重要ポイント:
    • 記録再現性: 実行ごとの差異をログに残せると、改善効果の比較が容易。
    • 指標は複数記録: 総時間・高分解能区間・行数・速度など、後で分析可能に。

例題で練習（貼って試せる）

  • 例1：全体計測（Timer）:
    • 目的は「ざっくり何秒かかるか」。テンプレ1で処理前後を挟む。
  • 例2：区間計測（Tick）:
    • 読み込み・整形・書き戻しのどこが遅いかを可視化。
  • 例3：高分解能比較:
    • 文字列処理A/Bのアルゴリズム比較。テンプレ3で ms を比較して採用を決定。
  • 例4：チャンク速度:
    • 20万行単位での行/秒を記録。チャンクサイズのチューニングに使う。
  • 例5：ログ連携:
    • 計測結果をファイルへ出力して、後でExcelで読み込み・グラフ化。

実務の落とし穴と対策（深掘り）

  • 落とし穴1：計測対象が揺れる（画面更新・再計算）
    • 対策: Application.ScreenUpdating=False、Calculation=Manual にしてから計測。最後に必ず復帰。
  • 落とし穴2：計測が重い
    • 対策: 軽量な Timer や最小限の Debug.Print に留める。ログは節目に絞る。
  • 落とし穴3：日跨ぎの Timer リセット
    • 対策: 長時間処理には区間計測＋累積で管理。必要なら高分解能タイマーに切り替える。
  • 落とし穴4：セル単位書き込みの遅さが支配的
    • 対策: 配列で一括読み書きに変更してから計測。計測以前に設計改善が最優先。
  • 落とし穴5：改善効果の比較が曖昧
    • 対策: 同じデータ・同じ環境で、総時間・区間時間・行/秒をログに残し、数値で比較。

最小スターター

  • 手順:
    • Timerで全体時間を測る（テンプレ1）。
    • Tickで区間計測を追加してボトルネックを特定。
    • 必要箇所だけ高分解能（テンプレ3）に切り替え。
    • チャンクの速度を出して、サイズや処理順の改善素材にする。
  • 拡張:
    • ログ基盤統合で計測値をファイルに保存。
    • StatusBarで進捗を出し、ユーザー体感を改善。
スポンサーリンク
タイトルとURLをコピーしました