Excel VBA 逆引き集 | バッチ実行

Excel VBA
スポンサーリンク
  1. ねらい：VBAで「バッチ実行」を安全に回し、長時間でも落ちない仕組みを作る
    1. 重要ポイントの深掘り
  2. バッチの基盤：開始・終了、ログ、進捗、失敗時復帰の枠
    1. 開始・終了の共通枠を必ず通す
    2. ログの最小実装で「何がいつ起きたか」を記録する
    3. 進捗は1〜5%刻みでUI更新を間引く
  3. タスクを並べて一括実行するバッチランナー
    1. タスクをSubとして登録し、順に走らせる
    2. 例題タスクの雛形（貼って差し替え）
  4. フォルダ内ファイルをバッチ処理するテンプレート
    1. 1ファイルずつ読み、失敗も記録して止めない設計
    2. 重要ポイントの深掘り
  5. スケジュール実行：OnTimeで時刻予約し、自動バッチを回す
    1. 指定時刻に実行し、完了後に次回を予約する
    2. 重要ポイントの深掘り
  6. 失敗対策：リトライ、バックアップ、排他ロック
    1. 保存や外部I/Oのリトライを入れて詰まりを回避する
    2. 実行中フラグで二重起動を防ぐ
    3. 重要ポイントの深掘り
  7. チャンク処理：巨大データを分割してピーク負荷を下げる
    1. 行チャンクで読み・処理・書き戻し・解放を繰り返す
    2. 重要ポイントの深掘り
  8. 例題の通し方と確認ポイント
    1. 最小セットで「一括→ログ→進捗→CSV」まで回す
    2. フォルダ一括とチャンク集計の組み合わせで現場データに耐える
  9. まとめ：バッチは「枠・ログ・進捗・失敗許容」で安定運用になる

ねらい：VBAで「バッチ実行」を安全に回し、長時間でも落ちない仕組みを作る

バッチ実行は「人の操作なしに、複数の処理を決まった順でまとめて走らせる」ことです。Excelでも、タスクの並べ方、開始・終了の枠、ログ・進捗、失敗時の復帰、ファイル一括処理、スケジュール実行（OnTime）を組み合わせれば、実務レベルのバッチが構築できます。初心者が貼って動かせるテンプレと、なぜその形が「落ちない・壊れない」かを丁寧に説明します。

重要ポイントの深掘り

バッチは「止め方・戻し方」を先に用意するのが鉄則です。開始で描画・イベント・再計算を止め、終了で必ず元に戻す。各タスクは「独立して失敗・成功を記録」できるように枠を持たせます。進捗は1〜5%刻みで間引き、ログはStart/Finish/Errorを残すと、長時間でも安心して回せます。

バッチの基盤：開始・終了、ログ、進捗、失敗時復帰の枠

開始・終了の共通枠を必ず通す

' ModApp.bas
Option Explicit
Public Sub AppEnter(Optional ByVal status As String = "")
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    If Len(status) > 0 Then Application.StatusBar = status
End Sub
Public Sub AppLeave()
    Application.StatusBar = False
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
VB

ログの最小実装で「何がいつ起きたか」を記録する

' ModLog.bas
Option Explicit
Public Sub LogInfo(ByVal action As String, ByVal detail As String)
    WriteLog "INFO", action, detail
End Sub
Public Sub LogError(ByVal action As String, ByVal detail As String)
    WriteLog "ERROR", action, detail
End Sub
Private Sub WriteLog(ByVal level As String, ByVal action As String, ByVal detail As String)
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = ThisWorkbook.Worksheets("Log")
    If ws Is Nothing Then Set ws = ThisWorkbook.Worksheets.Add: ws.Name = "Log"
    On Error GoTo 0
    Dim r As Long: r = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1
    ws.Cells(r, 1).Value = Format(Now, "yyyy-mm-dd HH:NN:SS")
    ws.Cells(r, 2).Value = level
    ws.Cells(r, 3).Value = action
    ws.Cells(r, 4).Value = detail
End Sub
VB

進捗は1〜5%刻みでUI更新を間引く

' ModProgress.bas
Option Explicit
Public Sub TickProgress(ByVal cur As Long, ByVal total As Long, Optional 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 & ")"
        DoEvents
    End If
End Sub
VB

タスクを並べて一括実行するバッチランナー

タスクをSubとして登録し、順に走らせる

' ModBatchRunner.bas
Option Explicit

Public Sub Run_Batch()
    On Error GoTo EH
    AppEnter "バッチ開始"
    LogInfo "Batch", "Start"

    RunTask "Task_ImportCsv"
    RunTask "Task_NormalizeData"
    RunTask "Task_Aggregate"
    RunTask "Task_ExportReport"

    LogInfo "Batch", "Finish"
    AppLeave
    MsgBox "バッチ完了", vbInformation
    Exit Sub
EH:
    LogError "Batch", Err.Number & " - " & Err.Description
    AppLeave
    MsgBox "バッチ失敗: " & Err.Description, vbExclamation
End Sub

Private Sub RunTask(ByVal taskName As String)
    On Error GoTo EH
    LogInfo taskName, "Start"
    Application.Run taskName
    LogInfo taskName, "Finish"
    Exit Sub
EH:
    LogError taskName, Err.Number & " - " & Err.Description
    ' 続行／停止の方針に応じて選ぶ（ここでは続行）
End Sub
VB

例題タスクの雛形（貼って差し替え）

' ModTasks.bas
Option Explicit

Public Sub Task_ImportCsv()
    ' CSVを読み取り、Inputシートへ書き出す
    Dim path As String: path = ThisWorkbook.Path & "\input.csv"
    Dim arr As Variant: arr = ReadCsvToArray(path)
    Worksheets("Input").Range("A1").Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
End Sub

Public Sub Task_NormalizeData()
    ' トリム・型整形など
    Dim arr As Variant: arr = Worksheets("Input").Range("A1").CurrentRegion.Value
    Dim r As Long, c As Long
    For r = 2 To UBound(arr, 1)
        For c = 1 To UBound(arr, 2)
            arr(r, c) = Trim$(CStr(arr(r, c)))
        Next
    Next
    Worksheets("Input").Range("A1").Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
End Sub

Public Sub Task_Aggregate()
    ' 合計をSummaryへ
    Dim arr As Variant: arr = Worksheets("Input").Range("A1").CurrentRegion.Value
    Dim idx As Long: idx = IndexByHeader(arr, "Amount")
    Dim s As Double, r As Long
    For r = 2 To UBound(arr, 1)
        s = s + CDbl(arr(r, idx))
        TickProgress r, UBound(arr, 1), "集計"
    Next
    Worksheets("Summary").Range("B2").Value = s
    Application.StatusBar = False
End Sub

Public Sub Task_ExportReport()
    ' OutputをCSVへ保存
    Dim arr As Variant: arr = Worksheets("Output").Range("A1").CurrentRegion.Value
    WriteArrayToCsv ThisWorkbook.Path & "\report.csv", arr
End Sub
VB
' ModCsvUtil.bas（簡易CSV I/O）
Option Explicit
Public Sub WriteArrayToCsv(ByVal path As String, ByVal data As Variant)
    Dim st As Object: Set st = CreateObject("ADODB.Stream")
    st.Type = 2: st.Charset = "UTF-8": st.Open
    Dim r As Long, c As Long, line As String
    For r = 1 To UBound(data, 1)
        line = ""
        For c = 1 To UBound(data, 2)
            Dim s As String: s = Replace(CStr(data(r, c)), """", """""")
            line = line & IIf(c > 1, ",", "") & """" & s & """"
        Next
        st.WriteText line & vbCrLf
    Next
    st.SaveToFile path, 2
    st.Close: Set st = Nothing
End Sub

Public Function ReadCsvToArray(ByVal path As String) As Variant
    Dim st As Object: Set st = CreateObject("ADODB.Stream")
    st.Type = 2: st.Charset = "UTF-8": st.Open: st.LoadFromFile path
    Dim text As String: text = st.ReadText: st.Close: Set st = Nothing
    Dim lines() As String: lines = Split(text, vbCrLf)
    If UBound(lines) < 0 Then Exit Function
    Dim head() As String: head = ParseCsvLine(lines(0))
    Dim cols As Long: cols = UBound(head) + 1
    Dim arr() As Variant: ReDim arr(1 To UBound(lines) + 1, 1 To cols)
    Dim c As Long: For c = 1 To cols: arr(1, c) = head(c - 1): Next
    Dim r As Long
    For r = 2 To UBound(lines) + 1
        If Len(lines(r - 1)) = 0 Then Exit For
        Dim rec() As String: rec = ParseCsvLine(lines(r - 1))
        For c = 1 To cols: arr(r, c) = IIf(c - 1 <= UBound(rec), rec(c - 1), ""): Next
    Next
    ReadCsvToArray = arr
End Function

Private Function ParseCsvLine(ByVal line As String) As String()
    Dim res() As String, buf As String, i As Long, inQ As Boolean
    ReDim res(0 To 0)
    For i = 1 To Len(line)
        Dim ch As String: ch = Mid$(line, i, 1)
        If ch = """" Then
            If inQ And i < Len(line) And Mid$(line, i + 1, 1) = """" Then buf = buf & """": i = i + 1 Else inQ = Not inQ
        ElseIf ch = "," And Not inQ Then res(UBound(res)) = buf: buf = "": ReDim Preserve res(0 To UBound(res) + 1)
        Else buf = buf & ch
        End If
    Next
    res(UBound(res)) = buf
    ParseCsvLine = res
End Function

Public Function IndexByHeader(ByVal data As Variant, ByVal name As String) As Long
    Dim j As Long
    For j = 1 To UBound(data, 2)
        If StrComp(CStr(data(1, j)), name, vbTextCompare) = 0 Then IndexByHeader = j: Exit Function
    Next
    Err.Raise 9100, , "ヘッダーがありません: " & name
End Function
VB

フォルダ内ファイルをバッチ処理するテンプレート

1ファイルずつ読み、失敗も記録して止めない設計

' ModFolderBatch.bas
Option Explicit

Public Sub Run_FolderBatch()
    On Error GoTo EH
    AppEnter "フォルダ一括"
    LogInfo "FolderBatch", "Start"

    Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
    Dim folder As Object: Set folder = fso.GetFolder(ThisWorkbook.Path & "\in")
    Dim file As Object

    Dim count As Long: count = 0
    For Each file In folder.Files
        If LCase$(fso.GetExtensionName(file.Name)) = "csv" Then
            ProcessCsvFile file.Path, count
        End If
    Next

    LogInfo "FolderBatch", "Finish count=" & count
    AppLeave
    MsgBox "処理完了: " & count & "件", vbInformation
    Exit Sub
EH:
    LogError "FolderBatch", Err.Number & " - " & Err.Description
    AppLeave
    MsgBox "失敗: " & Err.Description, vbExclamation
End Sub

Private Sub ProcessCsvFile(ByVal path As String, ByRef count As Long)
    On Error GoTo EH
    LogInfo "File", "Start " & path
    Dim arr As Variant: arr = ReadCsvToArray(path)
    ' ここで正規化や集計などを実施
    Worksheets("Staging").Range("A1").Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
    LogInfo "File", "Finish " & path
    count = count + 1
    Exit Sub
EH:
    LogError "File", "Error " & path & " - " & Err.Description
End Sub
VB

重要ポイントの深掘り

「1件失敗しても止めない」がバッチの基本です。各ファイルを独立してTry/Logできる構造にすると、全体の完了率が上がります。重い処理は配列I/Oでまとめて行い、進捗表示は件数基準で間引きます。

スケジュール実行：OnTimeで時刻予約し、自動バッチを回す

指定時刻に実行し、完了後に次回を予約する

' ModScheduler.bas
Option Explicit
Private gNext As Date

Public Sub ScheduleDaily(ByVal hhmm As String)
    ' 例: "02:00:00"（午前2時に毎日）
    Dim today As Date: today = Date + TimeValue(hhmm)
    If Now > today Then gNext = today + 1 Else gNext = today
    Application.OnTime gNext, "Run_Batch", , True
    MsgBox "次回実行予約: " & Format(gNext, "yyyy-mm-dd HH:NN:SS")
End Sub

Public Sub CancelSchedule()
    On Error Resume Next
    Application.OnTime gNext, "Run_Batch", , False
    On Error GoTo 0
End Sub
VB

重要ポイントの深掘り

OnTimeは「Excelが開いている間」だけ有効です。夜間バッチを狙うなら、PCとExcelを起動状態にしておく運用が必要です。完了後に次回を再予約する形や、起動時（Workbook_Open）に予約し直す形を併用すると安定します。

失敗対策：リトライ、バックアップ、排他ロック

保存や外部I/Oのリトライを入れて詰まりを回避する

' ModRetry.bas
Option Explicit
Public Function SaveCopyWithRetry(ByVal wb As Workbook, ByVal path As String, ByVal maxTry As Long) As Boolean
    Dim i As Long
    For i = 1 To maxTry
        On Error Resume Next
        wb.SaveCopyAs path
        If Err.Number = 0 Then SaveCopyWithRetry = True: Exit Function
        Err.Clear: Application.Wait Now + TimeValue("0:00:01")
        On Error GoTo 0
    Next
End Function
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

' 入口で使用
Public Sub Run_Batch_Safe()
    If Not TryLock() Then MsgBox "他のバッチが実行中です。", vbExclamation: Exit Sub
    On Error GoTo EH
    Run_Batch
    Unlock
    Exit Sub
EH:
    Unlock
End Sub
VB

重要ポイントの深掘り

バッチは「長時間・大量I/O」を伴います。外部保存の失敗は一定確率で起きるため、リトライ戦略が効きます。二重起動は破壊的な事故に直結するので、TryLock/Unlockを入口へ必ず入れます。失敗時でもUnlockが走るよう、Finally相当の構造にします。

チャンク処理：巨大データを分割してピーク負荷を下げる

行チャンクで読み・処理・書き戻し・解放を繰り返す

' ModChunkBatch.bas
Option Explicit

Public Sub Run_ChunkAggregate()
    On Error GoTo EH
    AppEnter "チャンク集計"
    Dim ws As Worksheet: Set ws = Worksheets("Input")
    Dim last As Long: last = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Dim chunk As Long: chunk = 5000
    Dim startRow As Long: startRow = 2
    Dim total As Double

    Do While startRow <= last
        Dim endRow As Long: endRow = WorksheetFunction.Min(startRow + chunk - 1, last)
        Dim arr As Variant: arr = ws.Range(ws.Cells(startRow, "A"), ws.Cells(endRow, "F")).Value
        Dim i As Long, idx As Long: idx = 4 ' 例：AmountがD列
        For i = 1 To UBound(arr, 1): total = total + CDbl(arr(i, idx)): Next
        TickProgress endRow, last, "チャンク"
        Erase arr
        startRow = endRow + 1
    Loop

    Worksheets("Summary").Range("B2").Value = total
    Application.StatusBar = False
    AppLeave
    MsgBox "合計: " & Format(total, "#,##0")
    Exit Sub
EH:
    AppLeave
    MsgBox "失敗: " & Err.Description, vbExclamation
End Sub
VB

重要ポイントの深掘り

巨大配列を一度に載せず、数千行単位で分割するとピークメモリと処理時間が安定します。各チャンクで必ずEraseを挟み、UI応答のための進捗は間引いて呼びます。必要に応じてOnTimeで次チャンクを予約すると、さらにフリーズしにくくなります。

例題の通し方と確認ポイント

最小セットで「一括→ログ→進捗→CSV」まで回す

Run_Batch を実行して、LogシートにStart/Finish/Errorが記録されるか、StatusBarに進捗が出るか、report.csvが生成されるかを確認します。タスクを1つずつ止め、単体でも動くか確かめると原因切り分けが容易です。

フォルダ一括とチャンク集計の組み合わせで現場データに耐える

Run_FolderBatch と Run_ChunkAggregate を試し、ファイル数や行数が増えても「止まらず・落ちず・終わる」ことを確認します。時間がかかる場合は、進捗ラベルを適切にしてUI安心感を確保します。

まとめ：バッチは「枠・ログ・進捗・失敗許容」で安定運用になる

開始・終了の枠で戻せる安心、ログで辿れる安心、進捗で待てる安心、失敗時も続行できる安心——この4つが揃えば、Excelでも立派なバッチ運用が可能です。

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