Excel VBA 逆引き集 | マルチスレッド風実装

Excel VBA
スポンサーリンク

ねらい：VBAを「協調的に分割」して、マルチスレッド風に同時進行させる

VBAはシングルスレッドですが、処理を小さなチャンクに分けて短時間で区切り、次の呼び出しを予約（Application.OnTime）しながらキューを回すと「同時に進んでいる体感」を作れます。重いループやI/O待ちを分割し、UI応答を保ちながら複数タスクを進める設計をテンプレートで示します。重要なのは、タスクの寿命管理、排他、キャンセル、進捗の間引き、例外でも必ず復帰する共通枠です。

原則：VBAはシングルスレッド。だから「協調的マルチタスク」でいく

協調の考え方（分割・予約・少しずつ進める）

長い処理を小さな単位（チャンク）に分割し、1チャンクだけ実行してすぐ復帰。次チャンクは1秒後などに予約します。複数タスクをキューに載せ、1チャンクずつ持ち回り（ラウンドロビン）で進めれば、CPUを独占せずUIも固まりません。停止フラグと実行ロックで暴走や重複起動を防ぎます。

重要ポイントの深掘り

  • OnTimeは「Excelが開いている間の予定実行」。完了時に次回を再予約する形で途切れない流れを作るのがコツ。
  • 1チャンクの処理時間は「100〜300ms程度」を目安（体感応答と速度のバランス）。重いI/Oはさらに小分け。
  • 進捗表示はチャンク終端だけにして、DoEventsは多用しない。過度のDoEventsは逆に遅くなります。

タスクキューの基本型：クラスでタスクを包み、OnTimeで回す

タスククラス（1件の仕事を分割して進める）

' CTask.cls（1つのタスクを「少しずつ」進める）
Option Explicit

Private pName As String
Private pTotal As Long
Private pCur As Long
Private pDone As Boolean

Public Sub Init(ByVal name As String, ByVal total As Long)
    pName = name: pTotal = total: pCur = 0: pDone = False
End Sub

Public Property Get Name() As String: Name = pName: End Property
Public Property Get IsDone() As Boolean: IsDone = pDone: End Property
Public Property Get ProgressText() As String
    ProgressText = pName & " " & Format(pCur / pTotal, "0%") & " (" & pCur & "/" & pTotal & ")"
End Property

Public Sub RunChunk(ByVal chunkSize As Long)
    Dim i As Long, limit As Long
    limit = WorksheetFunction.Min(pCur + chunkSize, pTotal)
    For i = pCur + 1 To limit
        ' ここに本処理の1件分（軽い単位）を書く：例）集計、正規化、検証など
        ' ...処理...
    Next
    pCur = limit
    If pCur >= pTotal Then pDone = True
End Sub
VB

タスクキュー（複数タスクを持ち回りで進める）

' CTaskQueue.cls（複数タスクをラウンドロビンで回す）
Option Explicit

Private tasks As Collection
Private idx As Long

Public Sub Init(): Set tasks = New Collection: idx = 0: End Sub

Public Sub AddTask(ByVal t As CTask): tasks.Add t: End Sub

Public Function AllDone() As Boolean
    Dim i As Long, t As CTask
    For i = 1 To tasks.Count
        Set t = tasks(i)
        If Not t.IsDone Then AllDone = False: Exit Function
    Next
    AllDone = True
End Function

Public Sub RunNext(ByVal chunkSize As Long)
    If tasks.Count = 0 Then Exit Sub
    idx = IIf(idx = 0, 1, idx)
    Dim startIdx As Long: startIdx = idx
    Dim t As CTask: Set t = tasks(idx)
    t.RunChunk chunkSize
    idx = IIf(idx = tasks.Count, 1, idx + 1)
End Sub

Public Function ProgressSummary() As String
    Dim s As String, i As Long, t As CTask
    For i = 1 To tasks.Count
        Set t = tasks(i)
        s = s & IIf(Len(s) > 0, " | ", "") & t.ProgressText
    Next
    ProgressSummary = s
End Function
VB

スケジューラ（OnTimeで段階実行＋キャンセル）

' ModScheduler.bas
Option Explicit
Private gQueue As CTaskQueue
Private gNext As Date
Private gStop As Boolean

Public Sub StartMulti(ByVal intervalSec As Double, ByVal chunkSize As Long)
    gStop = False
    Set gQueue = New CTaskQueue: gQueue.Init
    Dim t1 As New CTask: t1.Init "Import", 12000
    Dim t2 As New CTask: t2.Init "Normalize", 8000
    Dim t3 As New CTask: t3.Init "Aggregate", 5000
    gQueue.AddTask t1: gQueue.AddTask t2: gQueue.AddTask t3
    ScheduleNext intervalSec, chunkSize
End Sub

Public Sub StopMulti(): gStop = True: Application.StatusBar = False: End Sub

Private Sub ScheduleNext(ByVal sec As Double, ByVal chunkSize As Long)
    gNext = Now + sec / 86400#
    Application.OnTime gNext, "'" & ThisWorkbook.Name & "'!TickMulti", , True
    ' chunkSizeは静的に保持できないため、別プロシージャで固定長を使うか、Configで読む
    ThisWorkbook.Names.Add Name:="nm_ChunkSize", RefersTo:="=" & chunkSize
End Sub

Public Sub TickMulti()
    If gStop Then Exit Sub
    Dim chunkSize As Long
    On Error Resume Next
    chunkSize = CLng(ThisWorkbook.Names("nm_ChunkSize").RefersTo)
    On Error GoTo 0

    gQueue.RunNext IIf(chunkSize > 0, chunkSize, 500)

    Application.StatusBar = gQueue.ProgressSummary

    If gQueue.AllDone Then
        Application.StatusBar = "完了"
        Exit Sub
    End If
    ScheduleNext 0.5, chunkSize ' 0.5秒後に次チャンク
End Sub
VB

重要ポイントの深掘り

  • タスクの「1件分の重さ」を一定にして、chunkSizeで刻むと、複数タスクが公平に進みます。
  • OnTime予約は、プロシージャ名をブック修飾（’Book.xlsm’!Proc）で指定すると安定します。
  • キャンセル（StopMulti）は「次Tick開始時に抜ける」作りが安全。途中中断でも必ずStatusBarを戻します。

例題：巨大配列の三工程を「交替で進める」

シナリオ

Inputの12,000行をImport→8,000行をNormalize→5,000行をAggregateに見立て、各工程のRunChunk内で軽い処理を1件ずつ進める設定。StartMulti で開始、StopMulti で停止。

実行の流れ

StartMulti(0.0, 500) を呼ぶと即座にTickが走り、Import500件→Normalize500件→Aggregate500件→…の順で持ち回り進行。UIは操作可能のまま、StatusBarに各工程の進捗が並びます。完了すると「完了」表示で止まります。

非同期HTTPの併用：XMLHTTPのイベントで「待たずに次へ」

WithEventsでXMLHTTPのReadyStateを拾う

' CHttpGet.cls（軽量な非同期GET）
Option Explicit

Public WithEvents X As Object
Private pDone As Boolean

Public Sub Start(ByVal url As String)
    Set X = CreateObject("MSXML2.XMLHTTP")
    X.Open "GET", url, True ' True=非同期
    X.Send
End Sub

Private Sub X_onreadystatechange()
    If X.readyState = 4 Then
        If X.Status = 200 Then
            ' 取得データをバッファへ格納（グローバルやレポジトリへ）
        End If
        pDone = True
    End If
End Sub

Public Property Get IsDone() As Boolean: IsDone = pDone: End Property
VB

重要ポイントの深掘り

XMLHTTPの非同期は「ネット待ちでUIを固めない」定番です。VBAはイベントで完了を受け取り、メインのタスクキューは通常通り進行。通信と計算が「並んで進む体感」になります。失敗時のリトライはTickの側で制御しましょう。

別プロセス並列：PowerShellや外部EXEに分散して「本当の並行」

外部に投げて、完了ファイルをポーリングする

' ModExternalParallel.bas
Option Explicit

Public Sub StartExternalJob(ByVal ps1 As String, ByVal args As String, ByVal donePath As String)
    Dim sh As Object: Set sh = CreateObject("WScript.Shell")
    Dim cmd As String: cmd = "powershell -ExecutionPolicy Bypass -File """ & ps1 & """ " & args
    sh.Run cmd, 0, False ' 非同期起動（待たない）
    ' Tick側で donePath の存在をチェックして取り込み
End Sub

Public Function IsJobDone(ByVal donePath As String) As Boolean
    IsJobDone = (Dir(donePath, vbNormal) <> "")
End Function
VB

重要ポイントの深掘り

VBA自体は1スレッドでも、外部プロセスは独立に並行実行できます。ジョブIDや完了ファイルを契約にすると、キューが「外部＆内部」を混在して回せます。エラーはログに記録し、タイムアウトポリシーを持つと現場で止まりません。

長時間処理のチャンク設計：速度と体感のバランス

チャンクの大きさとUI更新の頻度

1チャンクは「100〜300ms」程度を目安に、実データで調整。進捗は「1〜5%刻み」でStatusBar更新を間引きます。UI更新はチャンク終端だけに集約し、DoEventsは可能なら使わない（OnTimeがUI応答を担保）。

例：進捗の間引き

' ModProgress.bas
Option Explicit

Public Sub TickProgress(ByVal cur As Long, ByVal total As Long, ByVal label As String)
    If total <= 0 Then Exit Sub
    Dim stepN As Long: stepN = Application.WorksheetFunction.Max(1, total \ 100)
    If cur Mod stepN = 0 Then Application.StatusBar = label & " " & Format(cur / total, "0%") & " (" & cur & "/" & total & ")"
End Sub
VB

排他・キャンセル・復帰：事故を未然に防ぐ

実行ロックで二重起動を防ぐ

' ModLock.bas
Option Explicit

Public Function TryLock() As Boolean
    On Error Resume Next
    ThisWorkbook.Names("nm_Lock").RefersToRange.Value = Environ$("UserName") & "@" & Format(Now, "yyyy-mm-dd HH:NN:SS")
    TryLock = (Err.Number = 0)
    Err.Clear
    On Error GoTo 0
End Function

Public Sub Unlock()
    On Error Resume Next
    ThisWorkbook.Names("nm_Lock").RefersToRange.Value = ""
    On Error GoTo 0
End Sub
VB

開始・終了の共通枠（必ず戻す）

' ModApp.bas
Option Explicit

Public Sub AppEnter(Optional ByVal status As String = "")
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    If Len(status) > 0 Then Application.StatusBar = status
End Sub

Public Sub AppLeave()
    Application.StatusBar = False
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
VB

重要ポイントの深掘り

  • 二重起動は破壊的な事故につながります。入口でTryLock、終了時はUnlockを必ず。例外時でもFinally相当の構造（AppLeaveとUnlock到達）を保証。
  • キャンセルはフラグを立てて「次Tickで抜ける」。途中で止めても必ず環境が戻る設計にします。

導入手順と確認の道筋

導入手順

StartMultiで三タスクの持ち回りを開始し、StatusBarに進捗が並び、Excel操作ができることを確認します。StopMultiで安全に停止できるか、StatusBarが消えるかを確認。チャンクサイズを変え、速度と体感のバランスを掴んでください。

確認ポイント

  • UIが固まらない（セル選択やスクロールが効く）。
  • 進捗が交互に増える（Import→Normalize→Aggregate）。
  • 完了時に再予約されず止まる（AllDone判定）。
  • 例外時でもAppLeave到達し、操作性が帰る。

まとめ：VBAは「協調分割＋予約＋持ち回り」で同時進行の体感を作れる

  • 仕事をチャンクに分割し、OnTimeで段階実行。
  • タスクキューで複数工程を公平に回し、UIを固めない。
  • 非同期HTTPや外部プロセスを織り交ぜれば、実質的な並行も可能。
  • 排他・キャンセル・復帰の枠を標準装備して、長時間でも落ちない。

スポンサーリンク
タイトルとURLをコピーしました