Excel VBA 逆引き集 | 非同期実行（擬似）

Excel VBA

2025.12.15

ねらい：VBAで「止まらないUI」を作る擬似・非同期実行
最短テンプレ：大ループをチャンク化＋DoEvents
擬似非同期の主役：OnTimeで「次チャンク」を予約
キャンセルボタン連携（シートボタン or ユーザーフォーム）
例題：行処理を擬似非同期で「固めずに」進める
OnTimeの注意点と運用コツ
擬似非同期の設計パターン（使い回しに効く）
例題で練習（貼って試せる）
実務の落とし穴と対策（ここが肝）
スターター手順（最短導入）

ねらい：VBAで「止まらないUI」を作る擬似・非同期実行

VBAは基本「同期（直列）処理」です。しかし実務では「長い処理をしつつ、UIは応答してほしい」「途中でキャンセルしたい」「進捗を見せたい」というニーズが強い。そこで、VBAだけでできる「擬似的な非同期」の作り方をテンプレで解説します。ポイントは「処理を小分けにしてスケジューリング」「DoEventsでUI応答」「OnTimeで次のチャンクを予約」です。

目的: 長処理でもUIを固めない、進捗更新とキャンセルを受け付ける
基本戦略:
- チャンク実行: 大量ループを「小さな塊」に分けて順次実行
- UI応答確保: 各チャンクで DoEvents を挟む
- スケジューリング: Application.OnTime で次チャンクを予約（実質タイマー）
重要ポイント（深掘り）：
- VBAは本当の並行実行ではない。だが「待ち時間にUIへ制御を返す」ことで体感は非同期に近づく
- 共有状態（変数）の管理を丁寧に。開始・停止・完了のライフサイクルを設計する

最短テンプレ：大ループをチャンク化＋DoEvents

大量ループをそのまま回すとUIが固まります。まずは「間引き更新＋DoEvents」で固まり防止。

Sub ProcessWithDoEvents()
    Dim total As Long: total = 200000
    Dim i As Long
    
    Application.ScreenUpdating = False
    
    For i = 1 To total
        ' --- 本処理例 ---
        Dim s As String: s = "テスト" & i
        ' -----------------
        
        ' 進捗更新＋UI応答を間引き
        If i Mod 500 = 0 Then
            Application.StatusBar = "進捗 " & Format(i / total, "0%") & " (" & i & "/" & total & ")"
            DoEvents
        End If
    Next
    
    Application.ScreenUpdating = True
    Application.StatusBar = False
    MsgBox "処理完了！"
End Sub

Sub ProcessWithDoEvents()
    Dim total As Long: total = 200000
    Dim i As Long
    
    Application.ScreenUpdating = False
    
    For i = 1 To total
        ' --- 本処理例 ---
        Dim s As String: s = "テスト" & i
        ' -----------------
        
        ' 進捗更新＋UI応答を間引き
        If i Mod 500 = 0 Then
            Application.StatusBar = "進捗 " & Format(i / total, "0%") & " (" & i & "/" & total & ")"
            DoEvents
        End If
    Next
    
    Application.ScreenUpdating = True
    Application.StatusBar = False
    MsgBox "処理完了！"
End Sub

重要ポイント（深掘り）：
- DoEventsは呼びすぎない: 100～500件ごとなど「間引き」が鉄則。呼びすぎると遅くなる
- UI応答が戻る: ユーザーがEscやボタンを押せるようになる（キャンセル対応は後述）

擬似非同期の主役：OnTimeで「次チャンク」を予約

Application.OnTime は「指定時刻に指定マクロを呼ぶ」仕組み。これで処理を小分けにし「少し待つ→次を実行」を繰り返せば、UIは操作可能なまま処理が進みます。

' グローバル状態（標準モジュール先頭）
Public gRun As Boolean
Public gIndex As Long
Public gTotal As Long

Sub StartPseudoAsync()
    gRun = True
    gIndex = 1
    gTotal = 100000
    
    Application.StatusBar = "開始..."
    ScheduleNextChunk  ' 最初のチャンクを予約
End Sub

Private Sub ScheduleNextChunk()
    ' 0.05秒後に次チャンク（疑似タイマー）
    Application.OnTime EarliestTime:=Now + TimeSerial(0, 0, 0) + TimeValue("00:00:00.05"), _
                       Procedure:="RunChunk", Schedule:=True
End Sub

Sub RunChunk()
    If Not gRun Then Exit Sub
    
    Dim i As Long, chunkSize As Long: chunkSize = 1000 ' 1チャンクの件数（調整可）
    Dim limit As Long: limit = WorksheetFunction.Min(gIndex + chunkSize - 1, gTotal)
    
    Application.ScreenUpdating = False
    
    For i = gIndex To limit
        ' --- 本処理 ---
        Dim s As String: s = "テスト" & i
        ' --------------
        
        ' 軽く間引いてUI応答（チャンク内でも少しだけ）
        If i Mod 250 = 0 Then DoEvents
    Next
    
    gIndex = limit + 1
    Application.StatusBar = "進捗 " & Format((gIndex - 1) / gTotal, "0%") & " (" & (gIndex - 1) & "/" & gTotal & ")"
    Application.ScreenUpdating = True
    
    If gIndex <= gTotal And gRun Then
        ScheduleNextChunk    ' 次チャンクを予約
    Else
        FinishPseudoAsync    ' 完了
    End If
End Sub

Sub StopPseudoAsync()
    gRun = False
    Application.StatusBar = False
    MsgBox "処理を停止しました。"
End Sub

Private Sub FinishPseudoAsync()
    gRun = False
    Application.StatusBar = False
    MsgBox "処理完了！"
End Sub

' グローバル状態（標準モジュール先頭）
Public gRun As Boolean
Public gIndex As Long
Public gTotal As Long

Sub StartPseudoAsync()
    gRun = True
    gIndex = 1
    gTotal = 100000
    
    Application.StatusBar = "開始..."
    ScheduleNextChunk  ' 最初のチャンクを予約
End Sub

Private Sub ScheduleNextChunk()
    ' 0.05秒後に次チャンク（疑似タイマー）
    Application.OnTime EarliestTime:=Now + TimeSerial(0, 0, 0) + TimeValue("00:00:00.05"), _
                       Procedure:="RunChunk", Schedule:=True
End Sub

Sub RunChunk()
    If Not gRun Then Exit Sub
    
    Dim i As Long, chunkSize As Long: chunkSize = 1000 ' 1チャンクの件数（調整可）
    Dim limit As Long: limit = WorksheetFunction.Min(gIndex + chunkSize - 1, gTotal)
    
    Application.ScreenUpdating = False
    
    For i = gIndex To limit
        ' --- 本処理 ---
        Dim s As String: s = "テスト" & i
        ' --------------
        
        ' 軽く間引いてUI応答（チャンク内でも少しだけ）
        If i Mod 250 = 0 Then DoEvents
    Next
    
    gIndex = limit + 1
    Application.StatusBar = "進捗 " & Format((gIndex - 1) / gTotal, "0%") & " (" & (gIndex - 1) & "/" & gTotal & ")"
    Application.ScreenUpdating = True
    
    If gIndex <= gTotal And gRun Then
        ScheduleNextChunk    ' 次チャンクを予約
    Else
        FinishPseudoAsync    ' 完了
    End If
End Sub

Sub StopPseudoAsync()
    gRun = False
    Application.StatusBar = False
    MsgBox "処理を停止しました。"
End Sub

Private Sub FinishPseudoAsync()
    gRun = False
    Application.StatusBar = False
    MsgBox "処理完了！"
End Sub

重要ポイント（深掘り）：
- OnTimeの遅延はUIの呼吸: 小休止でExcelが他イベント（クリック、キー入力）を処理できる
- チャンクサイズ調整: 大きいほど速いがUIは重くなる。PC性能と処理内容に合わせて最適化
- 安全停止: gRun をFalseにすれば次チャンクが走らず安全停止

キャンセルボタン連携（シートボタン or ユーザーフォーム）

シートボタン: 「停止」ボタンに StopPseudoAsync を割り当てるだけ
フォームボタン: 非モーダル表示で押せるようにし、ボタンで gRun=False をセット

Sub ShowCancelForm()
    UserForm1.Label1.Caption = "実行中... 停止したい場合はボタンを押してください"
    UserForm1.Show vbModeless
End Sub

' UserForm1 の停止ボタン
Private Sub CommandButtonCancel_Click()
    StopPseudoAsync
    Unload Me
End Sub

Sub ShowCancelForm()
    UserForm1.Label1.Caption = "実行中... 停止したい場合はボタンを押してください"
    UserForm1.Show vbModeless
End Sub

' UserForm1 の停止ボタン
Private Sub CommandButtonCancel_Click()
    StopPseudoAsync
    Unload Me
End Sub

重要ポイント（深掘り）：
- 非モーダル表示: 処理中でもボタンが押せる
- 後片付け: 停止時・完了時にフォームを閉じる／StatusBarをクリア

例題：行処理を擬似非同期で「固めずに」進める

シートのA列を加工する想定。進捗率をステータスバーに、停止ボタンで中断可能。

Public gR As Long, gLast As Long, gRun2 As Boolean

Sub StartAsyncRowProcess()
    Dim ws As Worksheet: Set ws = Worksheets("Data")
    gR = 2 ' データ開始行
    gLast = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    gRun2 = True
    
    Application.StatusBar = "開始..."
    Application.OnTime Now + TimeValue("00:00:00.05"), "RowChunk"
End Sub

Sub RowChunk()
    If Not gRun2 Then Exit Sub
    Dim ws As Worksheet: Set ws = Worksheets("Data")
    Dim countPerChunk As Long: countPerChunk = 800
    Dim endR As Long: endR = WorksheetFunction.Min(gR + countPerChunk - 1, gLast)
    
    Application.ScreenUpdating = False
    Dim r As Long
    For r = gR To endR
        ' --- 本処理例：A値を加工してBへ ---
        ws.Cells(r, "B").Value = "加工:" & CStr(ws.Cells(r, "A").Value)
        If r Mod 200 = 0 Then DoEvents
    Next
    Application.ScreenUpdating = True
    
    gR = endR + 1
    Application.StatusBar = "進捗 " & Format((gR - 1 - 2 + 1) / (gLast - 2 + 1), "0%") & " (" & (gR - 1) & "/" & gLast & ")"
    
    If gR <= gLast And gRun2 Then
        Application.OnTime Now + TimeValue("00:00:00.05"), "RowChunk"
    Else
        gRun2 = False
        Application.StatusBar = False
        MsgBox "行処理完了！"
    End If
End Sub

Sub StopAsyncRowProcess()
    gRun2 = False
    Application.StatusBar = False
    MsgBox "行処理を停止しました。"
End Sub

Public gR As Long, gLast As Long, gRun2 As Boolean

Sub StartAsyncRowProcess()
    Dim ws As Worksheet: Set ws = Worksheets("Data")
    gR = 2 ' データ開始行
    gLast = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    gRun2 = True
    
    Application.StatusBar = "開始..."
    Application.OnTime Now + TimeValue("00:00:00.05"), "RowChunk"
End Sub

Sub RowChunk()
    If Not gRun2 Then Exit Sub
    Dim ws As Worksheet: Set ws = Worksheets("Data")
    Dim countPerChunk As Long: countPerChunk = 800
    Dim endR As Long: endR = WorksheetFunction.Min(gR + countPerChunk - 1, gLast)
    
    Application.ScreenUpdating = False
    Dim r As Long
    For r = gR To endR
        ' --- 本処理例：A値を加工してBへ ---
        ws.Cells(r, "B").Value = "加工:" & CStr(ws.Cells(r, "A").Value)
        If r Mod 200 = 0 Then DoEvents
    Next
    Application.ScreenUpdating = True
    
    gR = endR + 1
    Application.StatusBar = "進捗 " & Format((gR - 1 - 2 + 1) / (gLast - 2 + 1), "0%") & " (" & (gR - 1) & "/" & gLast & ")"
    
    If gR <= gLast And gRun2 Then
        Application.OnTime Now + TimeValue("00:00:00.05"), "RowChunk"
    Else
        gRun2 = False
        Application.StatusBar = False
        MsgBox "行処理完了！"
    End If
End Sub

Sub StopAsyncRowProcess()
    gRun2 = False
    Application.StatusBar = False
    MsgBox "行処理を停止しました。"
End Sub

重要ポイント（深掘り）：
- 最終行の事前取得: 総件数が分かると進捗計算ができる
- チャンク内でDoEvents: 応答を担保しつつ高速さを保つ

OnTimeの注意点と運用コツ

重要ポイント（深掘り）：
- Excelが閉じられるとOnTimeは無効: 継続タスクには不向き。Excel起動中のみ前提
- 二重予約の防止: 再入防止フラグ（実行中は予約しない）を設けると安全
- 例外時の復旧: エラーで抜けた場合でも StatusBar=False、フラグFalseに戻す「Finally」的後片付けを必ず入れる
- タイマー間隔: 0.02～0.2秒程度が現実的。短すぎると予約コストが増え、長すぎると体感が鈍い

擬似非同期の設計パターン（使い回しに効く）

ラッパー関数で開始/停止/完了の3点セット:
- 開始: 初期化→最初のチャンク予約
- 停止: フラグFalse→後片付け
- 完了: フラグFalse→進捗100%→通知→片付け
共通モジュールで「スケジューラ」を持つ:
- Label/StatusBar更新は共通関数化し、あらゆる処理で使い回す
進捗・ETA表示:
- 経過時間から残り秒を推定し、テキストへ「残り約XX秒」追加（体感アップ）

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

例1：StartPseudoAsync→疑似非同期でチャンク処理を体感（StopPseudoAsyncで停止）。
例2：行処理版でA列→B列加工を擬似非同期。最終行大でもUIが固まらない。
例3：キャンセルフォームを非モーダルで出し、停止ボタンを押して安全停止。
例4：チャンクサイズ調整で「速さ」と「応答性」のバランスをチューニング。

実務の落とし穴と対策（ここが肝）

落とし穴1：本当に並行にはならない
- 対策: 処理を細分化し、UIへ制御を返す設計で「体感非同期」を目指す。
落とし穴2：OnTimeの二重走り・暴走
- 対策: 実行中フラグで再入防止、予約/キャンセルの整合を保つ。
落とし穴3：共有状態の破損
- 対策: グローバル変数を最小化し、開始・停止・完了で必ず初期化/後片付け。
落とし穴4：描画/再計算の負荷
- 対策: チャンク内は ScreenUpdating=False、必要なときのみON。再計算はManualに切替も検討。
落とし穴5：例外でUIが置き去り
- 対策: 例外時でも必ず StatusBarを戻す・フラグをFalseに・ユーザーへ通知。