Excel VBA 逆引き集 | 完全自動システム構築

Excel VBA
スポンサーリンク
  1. ねらい：Excelだけで「完全自動」を構築し、毎日止まらず成果物を出し続ける
  2. 全体設計図：自動ラインの骨格を先に決める
    1. ライン構成とデータの流れ
    2. 重要ポイントの深掘り
  3. 共通枠と安全装置：必ず復帰・ロック・ログを標準装備
    1. 描画・イベント抑止と必ず元へ戻す
    2. 実行ロックで二重起動を防ぐ
    3. 日別ログを記録する
    4. 重要ポイントの深掘り
  4. 設定管理：編集しやすい外部設定を読む
    1. INI/CSV風の簡易設定読込
    2. 重要ポイントの深掘り
  5. スケジューラとタスク駆動：OnTimeで協調実行する
    1. スケジューラ（起動・停止・Tick）
    2. タスクキュー（監視→取り込み→検証→加工→出力→アーカイブ）
    3. 重要ポイントの深掘り
  6. 例題：毎日自動ETL（CSV取り込み→検証→集計→Excel出力→アーカイブ）
    1. 監視（新着CSVを見つける）
    2. 取り込み（配列I/Oで高速読込）
    3. 検証（必須列・型チェックを間引き表示）
    4. 加工（正規化・計算）
    5. 出力（集計テーブルを作成）
    6. アーカイブ（入力ファイルを移動）
    7. 重要ポイントの深掘り
  7. 監視と再試行：失敗を記録し、次Tickで必ず再開する
    1. リトライポリシー（最大回数・待機）
    2. 重要ポイントの深掘り
  8. 自動起動・終了連携：ブックイベントで勝手に動く
    1. 起動時にスケジューラ開始、終了時に停止
    2. 重要ポイントの深掘り
  9. 運用の深掘り：健全性監視・通知・台帳
    1. 健全性（ヘルスチェック）
    2. 通知（任意）
    3. 台帳化
  10. 落とし穴と対策
    1. セル往復の多用で固まる
    2. 二重起動での競合
    3. 長時間タスクの一括実行
    4. 設定の直書き
    5. 失敗時に止まる
  11. まとめ：設計を“壊れない型”にすれば、Excelでも完全自動は十分現実的

ねらい：Excelだけで「完全自動」を構築し、毎日止まらず成果物を出し続ける

人手を介さずに、定時起動→入力取り込み→検証・加工→集計・出力→ログ記録→通知まで流れる“自動ライン”をVBAで作ります。初心者でも貼って動くテンプレートを、設計図、スケジューラ、共通枠（復帰・例外・ログ）、設定、タスク分割、再試行・監視、そして自動起動・終了まで段階的に紹介します。重要なのは「壊れない仕組み作り」。失敗しても復帰し、次回に備える設計を最初から入れておくことです。

全体設計図：自動ラインの骨格を先に決める

ライン構成とデータの流れ

自動ラインは「設定読込→スケジューラ起動→タスクキュー実行→ログ・アーカイブ→通知」の一本流しです。タスクは小さく分割し、OnTimeで短いチャンクを何度も回す協調実行にします。入力監視はフォルダの新着ファイルを定期ポーリング。成果物は「日付入りファイル名」で上書きを避け、ログは日別にローテーションして検証可能にします。

重要ポイントの深掘り

  • チャンク化（100〜300ms）でUI応答を保ちながら自動処理を回すと、固まる事故が激減します。
  • エラーが出ても必ず復帰する「共通枠（AppEnter/AppLeave）」と「ログ（時刻＋カテゴリ＋メッセージ）」を最初に用意すると、運用が楽になります。
  • 設定は外部ファイル化（CSV/INI）して、コード修正なしでパスや時刻を切り替えられる設計にします。

共通枠と安全装置：必ず復帰・ロック・ログを標準装備

描画・イベント抑止と必ず元へ戻す

' 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

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

' ModLock.bas
Option Explicit
Private gLocked As Boolean

Public Function TryLock() As Boolean
    If gLocked Then Exit Function
    gLocked = True
    TryLock = True
End Function

Public Sub Unlock()
    gLocked = False
End Sub
VB

日別ログを記録する

' ModLog.bas
Option Explicit

Public Sub LogInfo(ByVal msg As String)
    WriteLog "INFO", msg
End Sub
Public Sub LogWarn(ByVal msg As String)
    WriteLog "WARN", msg
End Sub
Public Sub LogError(ByVal msg As String)
    WriteLog "ERROR", msg
End Sub

Private Sub WriteLog(ByVal level As String, ByVal msg As String)
    On Error Resume Next
    Dim p As String
    p = ThisWorkbook.Path & "\logs"
    If Dir(p, vbDirectory) = "" Then MkDir p
    Dim f As String
    f = p & "\" & Format(Date, "yyyy-mm-dd") & ".log"
    Dim h As Integer: h = FreeFile
    Open f For Append As #h
    Print #h, Format(Now, "yyyy-mm-dd HH:NN:SS") & " [" & level & "] " & msg
    Close #h
    On Error GoTo 0
End Sub
VB

重要ポイントの深掘り

  • 例外時でもAppLeaveへ到達させるのが“復帰の命”。開始・終了枠はすべての外枠に入れます。
  • ログは「レベル・時刻・内容」を固定フォーマットにすると、後から検索・抽出が容易です。
  • ロックは二重起動事故の保険。簡易ロックから始め、必要なら名前定義や外部ファイルロックに拡張できます。

設定管理：編集しやすい外部設定を読む

INI/CSV風の簡易設定読込

' ModConfig.bas
Option Explicit
Private gCfg As Object

Public Sub LoadConfig(Optional ByVal path As String = "")
    Set gCfg = CreateObject("Scripting.Dictionary")
    If path = "" Then path = ThisWorkbook.Path & "\config.ini"
    If Dir(path, vbNormal) = "" Then Exit Sub

    Dim h As Integer: h = FreeFile
    Open path For Input As #h
    Dim line As String
    Do While Not EOF(h)
        Line Input #h, line
        line = Trim$(line)
        If Len(line) = 0 Or Left$(line, 1) = "#" Then GoTo NextLine
        Dim p As Long: p = InStr(line, "=")
        If p > 0 Then gCfg(LCase$(Trim$(Left$(line, p - 1)))) = Trim$(Mid$(line, p + 1))
NextLine:
    Loop
    Close #h
End Sub

Public Function Cfg(ByVal key As String, Optional ByVal defVal As String = "") As String
    If gCfg Is Nothing Then LoadConfig
    key = LCase$(key)
    If gCfg.Exists(key) Then Cfg = gCfg(key) Else Cfg = defVal
End Function
VB

設定例（config.ini）

  • InputFolder = C:\Data\Input
  • OutputFolder = C:\Data\Output
  • ArchiveFolder = C:\Data\Archive
  • TickMs = 200

重要ポイントの深掘り

  • 外部設定にすることで「時刻やパスの変更」が非エンジニアでも可能になります。
  • 既定値をコード側に持たせておくと、設定が欠けても動作継続できて安全です。

スケジューラとタスク駆動：OnTimeで協調実行する

スケジューラ（起動・停止・Tick）

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

Public Sub StartScheduler()
    If Not TryLock() Then Exit Sub
    LoadConfig
    gStop = False
    LogInfo "Scheduler start"
    Application.OnTime Now, "'" & ThisWorkbook.Name & "'!Tick", , True
End Sub

Public Sub StopScheduler()
    gStop = True
    LogInfo "Scheduler stop requested"
End Sub

Public Sub Tick()
    On Error GoTo EH
    If gStop Then GoTo EndFlow
    AppEnter "Tick"

    ' チャンク処理（約200ms程度）
    RunPipelineChunk

    AppLeave
    Dim ms As Double: ms = Val(Cfg("tickms", "200"))
    gNext = Now + (ms / 86400000#)
    Application.OnTime gNext, "'" & ThisWorkbook.Name & "'!Tick", , True
    Exit Sub
EH:
    LogError "Tick error: " & Err.Description
    AppLeave
    GoTo Reschedule
Reschedule:
    gNext = Now + (Val(Cfg("tickms", "500")) / 86400000#)
    Application.OnTime gNext, "'" & ThisWorkbook.Name & "'!Tick", , True
    Exit Sub
EndFlow:
    Unlock
    AppLeave
End Sub
VB

タスクキュー（監視→取り込み→検証→加工→出力→アーカイブ）

' ModPipeline.bas
Option Explicit
Private gState As String
Private gBuf As Variant
Private gInputFiles As Collection

Public Sub InitPipeline()
    Set gInputFiles = New Collection
    gState = "watch"
End Sub

Public Sub RunPipelineChunk()
    If gInputFiles Is Nothing Then InitPipeline

    Select Case gState
        Case "watch": If WatchInput() Then gState = "import"
        Case "import": If ImportChunk() Then gState = "validate"
        Case "validate": If ValidateChunk() Then gState = "transform"
        Case "transform": If TransformChunk() Then gState = "export"
        Case "export": If ExportChunk() Then gState = "archive"
        Case "archive": If ArchiveChunk() Then gState = "watch"
    End Select
End Sub
VB

重要ポイントの深掘り

  • 状態遷移（State Machine）にすると、途中で失敗しても“次のTickで再開”できます。
  • 各チャンクは短く終わること。長時間のI/Oは分割し、次回へ持ち越す設計にします。

例題：毎日自動ETL（CSV取り込み→検証→集計→Excel出力→アーカイブ）

監視（新着CSVを見つける）

' ModWatch.bas
Option Explicit

Public Function WatchInput() As Boolean
    Dim inDir As String: inDir = Cfg("inputfolder", ThisWorkbook.Path & "\input")
    Dim f As String: f = Dir(inDir & "\*.csv", vbNormal)
    Do While Len(f) > 0
        gInputFiles.Add inDir & "\" & f
        f = Dir
    Loop
    If gInputFiles.Count > 0 Then
        LogInfo "Found " & gInputFiles.Count & " CSV"
        WatchInput = True
    End If
End Function
VB

取り込み（配列I/Oで高速読込）

' ModImport.bas
Option Explicit
Private gCurFile As String
Private gData As Variant
Private gRowPtr As Long

Public Function ImportChunk() As Boolean
    If gCurFile = "" Then
        If gInputFiles.Count = 0 Then ImportChunk = True: Exit Function
        gCurFile = gInputFiles(1): gInputFiles.Remove 1
        gData = LoadCsv(gCurFile): gRowPtr = 2
        LogInfo "Import start: " & gCurFile
    End If
    ' 読込済み
    ImportChunk = True
End Function

Private Function LoadCsv(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
    Dim lines() As String: lines = Split(Replace(text, vbCrLf, vbLf), vbLf)
    Dim cols As Long: cols = UBound(Split(lines(0), ",")) + 1
    Dim a() As Variant: ReDim a(1 To UBound(lines) + 1, 1 To cols)
    Dim r As Long, c As Long
    Dim head() As String: head = Split(lines(0), ",")
    For c = 1 To cols: a(1, c) = head(c - 1): Next
    For r = 2 To UBound(a, 1)
        If r - 1 > UBound(lines) Then Exit For
        Dim rec() As String: rec = Split(lines(r - 1), ",")
        For c = 1 To cols: a(r, c) = IIf(c - 1 <= UBound(rec), rec(c - 1), ""): Next
    Next
    LoadCsv = a
End Function
VB

検証（必須列・型チェックを間引き表示）

' ModValidate.bas
Option Explicit
Private gErrors As Collection

Public Function ValidateChunk() As Boolean
    If gErrors Is Nothing Then Set gErrors = New Collection
    Dim endPtr As Long: endPtr = WorksheetFunction.Min(gRowPtr + 500, UBound(gData, 1))
    Dim r As Long
    For r = gRowPtr To endPtr
        If Len(Trim$(CStr(gData(r, 1)))) = 0 Then gErrors.Add "Row " & r & ": Key empty"
        If Not IsNumeric(gData(r, 3)) Then gErrors.Add "Row " & r & ": Amount not numeric"
    Next
    gRowPtr = endPtr + 1
    If gRowPtr > UBound(gData, 1) Then
        If gErrors.Count > 0 Then
            LogWarn "Validation errors: " & gErrors.Count
            WriteErrors gErrors
        Else
            LogInfo "Validation OK"
        End If
        ValidateChunk = True
    End If
End Function

Private Sub WriteErrors(ByVal errs As Collection)
    Dim ws As Worksheet: Set ws = PrepareOut("Errors")
    ws.Range("A1").Value = "Message"
    Dim i As Long
    For i = 1 To errs.Count
        ws.Cells(i + 1, "A").Value = errs(i)
    Next
    ws.Columns.AutoFit
End Sub

Private Function PrepareOut(ByVal name As String) As Worksheet
    Dim ws As Worksheet
    On Error Resume Next: Set ws = Worksheets(name): On Error GoTo 0
    If ws Is Nothing Then Set ws = Worksheets.Add: ws.Name = name
    ws.Cells.Clear
    Set PrepareOut = ws
End Function
VB

加工（正規化・計算）

' ModTransform.bas
Option Explicit

Public Function TransformChunk() As Boolean
    Dim r As Long
    For r = 2 To UBound(gData, 1)
        gData(r, 1) = LCase$(Trim$(CStr(gData(r, 1)))) ' Key normalize
        If IsNumeric(gData(r, 3)) Then gData(r, 3) = CDbl(gData(r, 3))
    Next
    TransformChunk = True
End Function
VB

出力（集計テーブルを作成）

' ModExport.bas
Option Explicit

Public Function ExportChunk() As Boolean
    Dim ws As Worksheet: Set ws = PrepareOut("Report")
    ws.Range("A1").Resize(UBound(gData, 1), UBound(gData, 2)).Value = gData
    ws.Columns.AutoFit
    ExportChunk = True
End Function
VB

アーカイブ（入力ファイルを移動）

' ModArchive.bas
Option Explicit

Public Function ArchiveChunk() As Boolean
    On Error Resume Next
    Dim arc As String: arc = Cfg("archivefolder", ThisWorkbook.Path & "\archive")
    If Dir(arc, vbDirectory) = "" Then MkDir arc
    Dim toPath As String
    toPath = arc & "\" & Format(Now, "yyyyMMdd_HHmmss") & "_" & Dir(gCurFile)
    Name gCurFile As toPath
    LogInfo "Archived: " & toPath
    gCurFile = "": Erase gData
    ArchiveChunk = True
End Function
VB

重要ポイントの深掘り

  • 取り込み・検証・加工・出力・アーカイブを“配列中心”で行い、セル往復を最小化すると速度が出ます。
  • 検証エラーはシートに一覧化して人間が判断できる形に。自動ラインでも“見える化”を残すと運用品質が上がります。

監視と再試行：失敗を記録し、次Tickで必ず再開する

リトライポリシー（最大回数・待機）

失敗時に「回数と次回までの待機」を持たせると、ネットワーク遅延やファイルロックでの一時的失敗に耐えられます。ログへ記録して、閾値超過で人間に通知（エラー件数の見える化）へ切り替えます。

重要ポイントの深掘り

  • “失敗して終了”ではなく“失敗して記録し、再試行して次へ”。完全自動はこの設計が肝です。
  • タイムアウト（例：60秒）を持たせ、永久リトライを防ぎます。運用側の判断に委ねる出口を必ず用意します。

自動起動・終了連携：ブックイベントで勝手に動く

起動時にスケジューラ開始、終了時に停止

' ThisWorkbook
Option Explicit

Private Sub Workbook_Open()
    StartScheduler
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    StopScheduler
End Sub
VB

重要ポイントの深掘り

  • xlsmをタスクスケジューラで開くだけで“勝手に動き、勝手に止まる”。Excel単体で完全自動が組めます。
  • クリティカルな運用では、Windows側のタスクスケジューラで“朝一でブックを開く”設定を合わせると万全です。

運用の深掘り：健全性監視・通知・台帳

健全性（ヘルスチェック）

毎日処理件数、エラー件数、所要時間をログから集計し、SysInfoシートへ可視化しておくと、異常兆候（急増・急減）にすぐ気づけます。

通知（任意）

通知は“ファイルで旗を立てる”だけでも有効です（例：done.txtに最終結果を書き、外部で拾う）。Outlook連携やPowerShellメール送信は必要に応じて追加します。

台帳化

入力ファイル名・出力ファイル名・ハッシュ（SHA-256）・時刻を日別シートに残すと、監査で強い運用になります。

落とし穴と対策

セル往復の多用で固まる

配列I/Oへ寄せる。読み出し→配列処理→一括書き戻しの型を守る。

二重起動での競合

TryLock/Unlockを必ず。起動イベントと手動起動が重なる事故を防ぐ。

長時間タスクの一括実行

チャンク化し、OnTimeで持ち回り。200ms程度で区切るとUI応答が保てます。

設定の直書き

config.iniへ外出し。パスや待機時間はコードに埋めない。

失敗時に止まる

ログ記録→再試行→タイムアウト→人間へ。段階設計で“必ず次へ”進む。

まとめ：設計を“壊れない型”にすれば、Excelでも完全自動は十分現実的

  • 共通枠（復帰・ロック・ログ）と外部設定を先に用意。
  • OnTime＋チャンク化の協調実行で止まらないラインを作る。
  • 監視→取り込み→検証→加工→出力→アーカイブのステートマシン化で、失敗しても次Tickで再開。
  • 起動・終了イベントとタスクスケジューラ併用で、毎日自動運転が可能。

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