Excel VBA 逆引き集 | 大規模運用のトラブル例

Excel VBA

2025.12.15

ねらい：大規模運用で「よく起きるトラブル」を具体例と対処テンプレで潰す
よくあるトラブル例と原因（現場頻度順）
検知テンプレート（兆候を早期に掴む仕掛け）
1. 実行監視とタイムログ（Immediateとシートに記録）
2. 命名・構造監査（規約違反の自動検出）
復旧プレイブック（実務的な「戻す」手順）
予防設計チェックリスト（運用前に必ず通す）
事例で学ぶ（再現→対策を貼って試す）
スターター手順（最短でトラブル耐性を付ける）

ねらい：大規模運用で「よく起きるトラブル」を具体例と対処テンプレで潰す

大量データ、複数人運用、長期利用。現場で本当に起きる失敗は、速度やメモリだけではありません。設定誤り、同時実行、バージョン違い、イベント暴走、印刷・外部I/Oの詰まり…を「兆候→原因→検知→復旧→予防」までひとまとめに。貼って使えるコードと運用ルールで、初心者でも安定運用できるようにします。

よくあるトラブル例と原因（現場頻度順）

大量データで固まる／途中で落ちる

原因: 1セルずつ読み書き、DoEvents過多、再計算・描画・イベントがON、印刷ページ区切り表示。
兆候: ステータスバー無表示、応答なし、処理が進んでいるか分からない。
対処の要点（深掘り）:
- 進捗を1〜5%刻みに表示して安心感を与えつつ、DoEventsは間引く。
- 配列I/Oへ全面置換。開始/終了で再計算・描画・イベントをOFF/ON。

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

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

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

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

同時実行でデータ破損（複数人が同時に動かす）

原因: 共有ブックでロック設計なし、同一ファイルへの同時書き込み。
兆候: 出力の上書き、競合ダイアログ、結果が混在。
対処の要点（深掘り）:
- 実行ロックを必ず導入（名前定義やLockシートで「今走っている」を明示）。
- 出力ファイルはタイムスタンプ＋ユーザー名を付け、上書きさせない。

' 単純ロック（Workbookスコープの名前定義 nm_Lock を使用）
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 = True
    On Error GoTo 0
End Function

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

' 単純ロック（Workbookスコープの名前定義 nm_Lock を使用）
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 = True
    On Error GoTo 0
End Function

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

重要（深掘り）:
- 「実行中」の可視化は誤起動抑止に効く。複数起動の根本対策は排他設計。

バージョン違いで挙動不一致（人や部署でコード差）

原因: .xlsm配布のたびに微妙に違う、共通ライブラリが各自改造。
兆候: 片方で動くのに、もう片方で失敗／ログ形式が違う。
対処の要点（深掘り）:
- .bas単位で部品化し、バージョン表記＋変更履歴を先頭コメントに。
- 入口Subを「Run_XXXX」に統一し、共通モジュールは契約（Public関数のシグネチャ）固定。

' ModProgress.bas
' Version: 1.2.0 / Changes: 1%間引きに統一 / Contract: ProgressThrottled(cur, total, label)
Option Explicit

' ModProgress.bas
' Version: 1.2.0 / Changes: 1%間引きに統一 / Contract: ProgressThrottled(cur, total, label)
Option Explicit

Config誤設定で本番事故（パス・しきい値・シート名）

原因: 設定がコード直書き、Configシートが未検証、VeryHiddenでないため誤編集。
兆候: 実行直後に「ファイルが見つかりません」／出力先が不正。
対処の要点（深掘り）:
- 実行前に型検証（string/number/boolean/path）を通す。
- ConfigはVeryHidden＋保護、管理者だけ表示編集。

Function GetConfigNumber(ByVal key As String) As Double
    Dim s As String: s = GetConfigString(key)
    If Not IsNumeric(s) Then Err.Raise 901, , "数値ではありません: " & key & "=" & s
    GetConfigNumber = CDbl(s)
End Function

Function GetConfigNumber(ByVal key As String) As Double
    Dim s As String: s = GetConfigString(key)
    If Not IsNumeric(s) Then Err.Raise 901, , "数値ではありません: " & key & "=" & s
    GetConfigNumber = CDbl(s)
End Function

イベント暴走（Change/Calculateが再帰的に発火）

原因: シートイベント内で更にセルを書き換え、永遠ループに。
兆候: キーボード操作だけでCPU100%、遅延・停止。
対処の要点（深掘り）:
- 実処理中は Application.EnableEvents = False にする。
- イベントの責務をクラスに閉じ込めて、発火条件を厳密に絞る。

外部I/Oの詰まり（ネットワーク保存・CSV書出し・印刷）

原因: ネットワーク断、PageSetup多用、PrintCommunicationがONのまま大量設定。
兆候: 保存で長時間ハング、印刷設定で応答なし。
対処の要点（深掘り）:
- 書き出しはフォルダ保証＋リトライ、印刷は Application.PrintCommunication=False でバッチ設定。
- 巨大シートは ActiveSheet.DisplayPageBreaks=False。

Sub EnsureFolder(ByVal folderPath As String)
    Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(folderPath) Then fso.CreateFolder folderPath
End Sub

Function SaveWithRetry(ByVal path As String, ByVal maxTry As Long) As Boolean
    Dim i As Long
    For i = 1 To maxTry
        On Error Resume Next
        ThisWorkbook.SaveCopyAs path
        If Err.Number = 0 Then SaveWithRetry = True: Exit Function
        Err.Clear: Application.Wait Now + TimeValue("0:00:01")
        On Error GoTo 0
    Next
End Function

Sub EnsureFolder(ByVal folderPath As String)
    Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(folderPath) Then fso.CreateFolder folderPath
End Sub

Function SaveWithRetry(ByVal path As String, ByVal maxTry As Long) As Boolean
    Dim i As Long
    For i = 1 To maxTry
        On Error Resume Next
        ThisWorkbook.SaveCopyAs path
        If Err.Number = 0 Then SaveWithRetry = True: Exit Function
        Err.Clear: Application.Wait Now + TimeValue("0:00:01")
        On Error GoTo 0
    Next
End Function

シート構造変更で壊れる（列追加・並び替え）

原因: 列番号直参照、ヘッダー依存の検証なし。
兆候: いつの間にか判定列がズレ、誤計算。
対処の要点（深掘り）:
- ListObjectの列名→Index参照に統一し、RequireHeaderで前提チェック。
- 変更検知を最初に行い、Fail Fastで止める。

検知テンプレート（兆候を早期に掴む仕掛け）

実行監視とタイムログ（Immediateとシートに記録）

Sub LogTime(ByVal label As String, ByVal sec As Double)
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = ThisWorkbook.Worksheets("PerfLog")
    If ws Is Nothing Then Set ws = ThisWorkbook.Worksheets.Add: ws.Name = "PerfLog"
    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 = label
    ws.Cells(r, 3).Value = sec
End Sub

Sub LogTime(ByVal label As String, ByVal sec As Double)
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = ThisWorkbook.Worksheets("PerfLog")
    If ws Is Nothing Then Set ws = ThisWorkbook.Worksheets.Add: ws.Name = "PerfLog"
    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 = label
    ws.Cells(r, 3).Value = sec
End Sub

深掘り: 「遅い」の感覚ではなく数値で管理。変更前後差が一目で分かる。

命名・構造監査（規約違反の自動検出）

Sub AuditNaming()
    Dim ws As Worksheet, lo As ListObject, nm As Name
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name Like "* *" Then Debug.Print "NG Space in sheet:", ws.Name
        If Not ws.Name Like "*_*" Then Debug.Print "WARN no underscore:", ws.Name
        For Each lo In ws.ListObjects
            If Not lo.Name Like "tbl*" Then Debug.Print "NG Table:", lo.Name
        Next
    Next
    For Each nm In ThisWorkbook.Names
        If Not nm.Name Like "nm_*" Then Debug.Print "NG Name:", nm.Name
    Next
End Sub

Sub AuditNaming()
    Dim ws As Worksheet, lo As ListObject, nm As Name
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name Like "* *" Then Debug.Print "NG Space in sheet:", ws.Name
        If Not ws.Name Like "*_*" Then Debug.Print "WARN no underscore:", ws.Name
        For Each lo In ws.ListObjects
            If Not lo.Name Like "tbl*" Then Debug.Print "NG Table:", lo.Name
        Next
    Next
    For Each nm In ThisWorkbook.Names
        If Not nm.Name Like "nm_*" Then Debug.Print "NG Name:", nm.Name
    Next
End Sub

復旧プレイブック（実務的な「戻す」手順）

1) 環境復帰＋進捗停止

Sub SafeExit(Optional ByVal msg As String = "")
    Application.StatusBar = False
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    If Len(msg) > 0 Then MsgBox msg, vbExclamation
End Sub

Sub SafeExit(Optional ByVal msg As String = "")
    Application.StatusBar = False
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    If Len(msg) > 0 Then MsgBox msg, vbExclamation
End Sub

2) バックアップから退路確保

Sub SafeBackup(ByVal tag As String)
    Dim path As String
    path = ThisWorkbook.Path & "\" & ThisWorkbook.Name & "_" & tag & ".bak"
    ThisWorkbook.SaveCopyAs path
End Sub

Sub SafeBackup(ByVal tag As String)
    Dim path As String
    path = ThisWorkbook.Path & "\" & ThisWorkbook.Name & "_" & tag & ".bak"
    ThisWorkbook.SaveCopyAs path
End Sub

3) 失敗ポイントの隔離（チャンク再実行）

失敗行番号・ファイル名・条件をログに残し、その塊だけ再処理する設計に。
深掘り: 「全部やり直し」を避けるため、塊単位（ページ・行範囲）で再実行できるようにしておく。

予防設計チェックリスト（運用前に必ず通す）

開始/終了枠（AppEnter/AppLeave）があるか
配列I/Oに切り替えているか（セル往復なし）
進捗1〜5%＋DoEvents間引きが入っているか
Config型検証＋VeryHidden＋保護があるか
ListObject列名参照＋RequireHeaderでFail Fastか
実行ロック（排他）と出力命名ルールがあるか
ログ（Start/Finish/Error/Warn）を記録しているか
バックアップ（SaveCopyAs）と復旧手順が定義されているか
.bas部品のバージョン表記と契約固定があるか
深掘り: “やったつもり”を防ぐのはリスト化。技術より仕組みが事故を減らす。

事例で学ぶ（再現→対策を貼って試す）

事例1：共有で二重起動→データ上書き

再現: 同時に「Run_Export」を2人が実行、ファイル上書き。
対策: TryLock/Unlock導入、ファイル名にUserName＋StampNow付与。

Function StampNow() As String: StampNow = Format(Now, "yyyy-mm-dd_HHNNSS"): End Function

Function StampNow() As String: StampNow = Format(Now, "yyyy-mm-dd_HHNNSS"): End Function

事例2：列追加で判定ズレ→誤計算

再現: 手作業で列を1つ挿入、判定列番号がズレる。
対策: ListObject列名Index化＋RequireHeader。

事例3：ネットワーク保存でハング

再現: 共有フォルダへ保存中ネットワーク遅延。
対策: EnsureFolder＋SaveWithRetry、保存前にSafeBackup。

スターター手順（最短でトラブル耐性を付ける）

共通枠（AppEnter/AppLeave）＋ログ（Start/Finish/Error）を導入。
配列I/Oへ置換、進捗とキャンセル（フラグ）を標準化。
Configを外出し＋型検証、VeryHidden＋保護。
ListObject列名参照＋RequireHeaderで前提崩れを早期停止。
実行ロック・出力命名ルール・バックアップ・保存リトライを追加。
.bas部品へ分離し、バージョン＋契約固定で配布・更新を楽に。

月	火	水	木	金	土	日
1	2	3	4	5	6	7
8	9	10	11	12	13	14
15	16	17	18	19	20	21
22	23	24	25	26	27	28
29	30	31