ねらい：シート構成を「自動検査」して壊れない運用にする
「必要なシートが揃っているか」「ヘッダーが正しいか」「保護・表示状態は適切か」――こうした”構成の前提”が崩れると、処理は簡単に壊れます。人の目で毎回チェックするのは限界。そこで、ブックを開いたら数秒で「シート構成の健全性」を自動検査し、問題があれば具体的に指摘するテンプレートを用意します。重要部分を深掘りしながら、初心者でも貼って動かせる形で解説します。
- 目的: 必須シートの有無・順序・可視性・保護・ヘッダー・データ型・名前定義・テーブル構造などを自動検査
- 基本戦略: 期待仕様を「Config（定義）」として持ち、検査は「ルールに照らして差分を出す」
- 重要ポイント（深掘り）:
- 検査は「失敗箇所を具体的に」出す（シート名・セル番地・期待値・実値）。
- ルールはコード直書きしない。配列・辞書にまとめて”定義変更だけ”で運用を変えられる設計が肝。
検査の骨子（何を見るか）
- シート存在と順序: 必須シートが全てあるか、順番（例：Menu→Input→Master→Output）が正しいか。
- 可視性と保護: Visible/Hidden/VeryHiddenの方針通りか、Protectされているべきシートが保護されているか。
- ヘッダー一致: 1行目の見出しが期待セット通りか（同義語・順序の許容ルールあり）。
- データ型・桁: 代表列が期待する型（数字・日付・文字長）を満たしているか、サンプル行で検査。
- 名前定義・テーブル構造: 必須の名前（例：API_KEY）やテーブル(ListObject)が存在・列構成が一致しているか。
- 数式の有無: 数式を禁止/許容する領域のルールに合っているか（例：入力欄は値のみ）。
検査定義テンプレ（Configで期待仕様を宣言）
' Config.bas：検査ルール定義（運用でここだけ差し替え）
Option Explicit
Public Type THeaderRule
SheetName As String
HeaderRow As Long
ExpectedHeaders As Variant ' 1次元配列
End Type
Public Function RequiredSheets() As Variant
' 必須シート（順序も定義）
RequiredSheets = Array("Menu", "Input", "Master", "Output", "Log", "Config")
End Function
Public Function VisibilityPolicy() As Object
' 可視性方針：Visible/Hidden/VeryHidden
Dim d As Object: Set d = CreateObject("Scripting.Dictionary")
d("Menu") = xlSheetVisible
d("Input") = xlSheetVisible
d("Master") = xlSheetHidden
d("Output") = xlSheetVisible
d("Log") = xlSheetHidden
d("Config") = xlSheetVeryHidden
Set VisibilityPolicy = d
End Function
Public Function ProtectionPolicy() As Object
' 保護方針：Trueなら保護必須
Dim d As Object: Set d = CreateObject("Scripting.Dictionary")
d("Menu") = True
d("Input") = False
d("Master") = True
d("Output") = False
d("Log") = False
d("Config") = True
Set ProtectionPolicy = d
End Function
Public Function HeaderRules() As Variant
' シートのヘッダー期待値
Dim r1 As THeaderRule, r2 As THeaderRule
r1.SheetName = "Input": r1.HeaderRow = 1
r1.ExpectedHeaders = Split("社員番号,氏名,電話,入社日", ",")
r2.SheetName = "Master": r2.HeaderRow = 1
r2.ExpectedHeaders = Split("社員番号,部署,部署名", ",")
HeaderRules = Array(r1, r2)
End Function
Public Function RequiredNames() As Variant
' 必須の名前定義（ブックスコープ）
RequiredNames = Array("API_KEY", "DATA_DIR")
End Function
Public Function RequiredTables() As Object
' 必須テーブルと期待列（ListObject）
Dim d As Object: Set d = CreateObject("Scripting.Dictionary")
d("tblEmployees") = Split("EmpNo,EmpName,Dept,HireDate", ",")
Set RequiredTables = d
End Function
- 重要ポイント（深掘り）:
- 検査対象をコードに埋め込まず「Config関数群」に集約。運用変更はここを直すだけ。
- ヘッダーは配列で管理、名前定義やテーブル列も辞書に入れて比較可能に。
コア検査テンプレ（結果は一覧テキストで出力）
' Inspector.bas：総合検査
Option Explicit
Public Sub InspectWorkbook()
Dim report As Collection: Set report = New Collection
' 1. シート存在と順序
CheckSheetPresenceAndOrder report
' 2. 可視性と保護
CheckVisibilityPolicy report
CheckProtectionPolicy report
' 3. ヘッダー一致
CheckHeaders report
' 4. 名前定義
CheckNames report
' 5. テーブル構造
CheckTables report
' 6. 代表列のデータ型・桁（簡易例）
CheckInputDataSample report
' 7. 数式が禁止領域にないか（簡易）
CheckNoFormulaInInput report
' 出力
ShowReport report
End Sub
- 重要ポイント（深掘り）:
- 検査は小関数に分けて「何がダメか」をピンポイントで出す。
- 必要なものだけ呼べる構造（柔軟性）。
シート存在・順序の検査
Private Sub CheckSheetPresenceAndOrder(ByRef report As Collection)
Dim req As Variant: req = RequiredSheets()
Dim i As Long
' 存在検査
For i = LBound(req) To UBound(req)
If GetSheet(CStr(req(i))) Is Nothing Then
report.Add "NG: 必須シートがありません → " & CStr(req(i))
End If
Next
' 順序検査
Dim okOrder As Boolean: okOrder = True
For i = LBound(req) To UBound(req)
If Not GetSheet(CStr(req(i))) Is Nothing Then
If Worksheets(CStr(req(i))).Index <> (i + 1) Then
okOrder = False
End If
End If
Next
If Not okOrder Then report.Add "WARN: シート順序が期待と異なります（Menu→Input→Master→Output→Log→Config）"
End Sub
Private Function GetSheet(ByVal name As String) As Worksheet
On Error Resume Next
Set GetSheet = ThisWorkbook.Worksheets(name)
On Error GoTo 0
End Function
- 重要ポイント（深掘り）:
- 順序は厳格性が必要か”WARN”に留めるかを運用で決める（壊れない設計）。
- 存在しない場合は”NG”で即修正対象。
可視性・保護の検査
Private Sub CheckVisibilityPolicy(ByRef report As Collection)
Dim pol As Object: Set pol = VisibilityPolicy()
Dim k As Variant
For Each k In pol.Keys
Dim ws As Worksheet: Set ws = GetSheet(CStr(k))
If ws Is Nothing Then GoTo NextK
If ws.Visible <> pol(k) Then
report.Add "NG: 可視性がポリシーと不一致 → " & ws.Name & " (期待=" & VisTag(pol(k)) & ", 実際=" & VisTag(ws.Visible) & ")"
End If
NextK:
Next
End Sub
Private Function VisTag(ByVal v As XlSheetVisibility) As String
Select Case v
Case xlSheetVisible: VisTag = "Visible"
Case xlSheetHidden: VisTag = "Hidden"
Case xlSheetVeryHidden: VisTag = "VeryHidden"
End Select
End Function
Private Sub CheckProtectionPolicy(ByRef report As Collection)
Dim pol As Object: Set pol = ProtectionPolicy()
Dim k As Variant
For Each k In pol.Keys
Dim ws As Worksheet: Set ws = GetSheet(CStr(k))
If ws Is Nothing Then GoTo NextK
Dim mustProtect As Boolean: mustProtect = pol(k)
If mustProtect And Not ws.ProtectContents Then
report.Add "NG: 保護が必要なのに未保護 → " & ws.Name
ElseIf (Not mustProtect) And ws.ProtectContents Then
report.Add "WARN: 保護不要だが保護されています → " & ws.Name
End If
NextK:
Next
End Sub
- 重要ポイント（深掘り）:
- VeryHiddenの扱いは厳格。設定漏れは”NG”。
- 保護の有無は誤操作防止の要。必須シートは未保護を”NG”に。
ヘッダー一致の検査（完全一致版）
Private Sub CheckHeaders(ByRef report As Collection)
Dim rules As Variant: rules = HeaderRules()
Dim i As Long
For i = LBound(rules) To UBound(rules)
Dim ws As Worksheet: Set ws = GetSheet(rules(i).SheetName)
If ws Is Nothing Then
report.Add "NG: ヘッダー検査対象シートなし → " & rules(i).SheetName
Else
Dim miss As String: miss = MissingHeaders(ws, rules(i).HeaderRow, rules(i).ExpectedHeaders)
If Len(miss) > 0 Then
report.Add "NG: ヘッダー不足 → " & ws.Name & " / 欠如: " & miss
End If
End If
Next
End Sub
Private Function MissingHeaders(ByVal ws As Worksheet, ByVal headerRow As Long, ByVal expected As Variant) As String
Dim lastCol As Long: lastCol = ws.Cells(headerRow, ws.Columns.Count).End(xlToLeft).Column
Dim colSet As Object: Set colSet = CreateObject("Scripting.Dictionary")
Dim c As Long
For c = 1 To lastCol
colSet(Trim$(CStr(ws.Cells(headerRow, c).Value))) = True
Next
Dim i As Long, miss As Collection: Set miss = New Collection
For i = LBound(expected) To UBound(expected)
If Not colSet.Exists(Trim$(CStr(expected(i)))) Then miss.Add expected(i)
Next
MissingHeaders = Join(CollectionToArray(miss), ", ")
End Function
Private Function CollectionToArray(ByVal col As Collection) As Variant
If col.Count = 0 Then CollectionToArray = Split("", ","): Exit Function
Dim i As Long, a() As String: ReDim a(1 To col.Count)
For i = 1 To col.Count: a(i) = CStr(col(i)): Next
CollectionToArray = a
End Function
- 重要ポイント（深掘り）:
- 欠如項目を列挙し、修正指示を明確化。
- 表記ゆれ対策（Trim・全角半角）の正規化を入れると命中率が上がる。
名前定義とテーブル構造の検査
Private Sub CheckNames(ByRef report As Collection)
Dim req As Variant: req = RequiredNames()
Dim i As Long
For i = LBound(req) To UBound(req)
If GetName(CStr(req(i))) Is Nothing Then
report.Add "NG: 必須の名前定義なし → " & CStr(req(i))
End If
Next
End Sub
Private Function GetName(ByVal nm As String) As Name
On Error Resume Next
Set GetName = ThisWorkbook.Names(nm)
On Error GoTo 0
End Function
Private Sub CheckTables(ByRef report As Collection)
Dim req As Object: Set req = RequiredTables()
Dim k As Variant
For Each k In req.Keys
Dim lo As ListObject: Set lo = FindTable(CStr(k))
If lo Is Nothing Then
report.Add "NG: 必須テーブルなし → " & CStr(k)
Else
Dim miss As String: miss = MissingTableColumns(lo, req(k))
If Len(miss) > 0 Then
report.Add "NG: テーブル列不足 → " & lo.Name & " / 欠如: " & miss
End If
End If
Next
End Sub
Private Function FindTable(ByVal name As String) As ListObject
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
Dim lo As ListObject
For Each lo In ws.ListObjects
If StrComp(lo.Name, name, vbTextCompare) = 0 Then
Set FindTable = lo: Exit Function
End If
Next
Next
End Function
Private Function MissingTableColumns(ByVal lo As ListObject, ByVal expected As Variant) As String
Dim setCols As Object: Set setCols = CreateObject("Scripting.Dictionary")
Dim i As Long
For i = 1 To lo.ListColumns.Count
setCols(Trim$(lo.ListColumns(i).Name)) = True
Next
Dim miss As Collection: Set miss = New Collection
For i = LBound(expected) To UBound(expected)
If Not setCols.Exists(Trim$(CStr(expected(i)))) Then miss.Add expected(i)
Next
MissingTableColumns = Join(CollectionToArray(miss), ", ")
End Function
- 重要ポイント（深掘り）:
- 名前定義は外部連携・パス・キーに使われる”前提”情報。欠如は即”NG”。
- テーブル(ListObject)は列名一致が命。列名変更の影響を検査で拾う。
データ型・桁の簡易検査（代表列サンプル）
Private Sub CheckInputDataSample(ByRef report As Collection)
Dim ws As Worksheet: Set ws = GetSheet("Input")
If ws Is Nothing Then Exit Sub
Dim lr As Long: lr = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
If lr < 2 Then report.Add "WARN: Inputが空です": Exit Sub
Dim sampleEnd As Long: sampleEnd = WorksheetFunction.Min(lr, 101)
Dim badEmp As Long, badTel As Long
Dim r As Long
For r = 2 To sampleEnd
Dim emp As String: emp = CStr(ws.Cells(r, "A").Value)
If (Len(emp) <> 6) Or (emp Like "*[!0-9]*") Then badEmp = badEmp + 1
Dim tel As String: tel = CStr(ws.Cells(r, "C").Value)
Dim digits As String: digits = ExtractDigits(tel)
If (Len(digits) < 10) Or (Len(digits) > 11) Then badTel = badTel + 1
Next
If badEmp > 0 Then report.Add "NG: 社員番号の形式不正サンプル " & badEmp & " 件（6桁数字想定）"
If badTel > 0 Then report.Add "NG: 電話番号の形式不正サンプル " & badTel & " 件（10～11桁数字想定）"
End Sub
Private Function ExtractDigits(ByVal s As String) As String
Dim i As Long, r As String
For i = 1 To Len(s)
Dim ch As String: ch = Mid$(s, i, 1)
If ch Like "[0-9]" Then r = r & ch
Next
ExtractDigits = r
End Function
- 重要ポイント（深掘り）:
- サンプル100行で十分な検知力。全件走査は重いので、構成検査は”軽く速く”が原則。
- 代表列のルール（桁・文字種）をConfig化すれば、現場仕様に合わせて拡張可能。
数式の禁止領域検査（入力欄は値のみ）
Private Sub CheckNoFormulaInInput(ByRef report As Collection)
Dim ws As Worksheet: Set ws = GetSheet("Input")
If ws Is Nothing Then Exit Sub
Dim lr As Long: lr = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Dim rng As Range: Set rng = ws.Range("A2:D" & lr) ' 入力欄想定
Dim hasFormula As Boolean
Dim c As Range
For Each c In rng
If c.HasFormula Then hasFormula = True: Exit For
Next
If hasFormula Then report.Add "NG: 入力欄に数式があります（値のみ想定）"
End Sub
- 重要ポイント（深掘り）:
- 入力欄へ数式が紛れると、編集で壊れやすい。禁止領域は必ず検査。
- 範囲はConfig化して柔軟に。
検査結果の表示と活用
Private Sub ShowReport(ByVal report As Collection)
If report.Count = 0 Then
MsgBox "OK: シート構成は健全です。"
Else
Dim lines() As String: ReDim lines(1 To report.Count)
Dim i As Long
For i = 1 To report.Count: lines(i) = CStr(report(i)): Next
Dim msg As String: msg = Join(lines, vbCrLf)
' メッセージ表示＋Logシートへ保存（任意）
MsgBox msg
On Error Resume Next
Dim ws As Worksheet: Set ws = GetSheet("Log")
If Not ws Is Nothing Then
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 = "Sheet構成検査"
ws.Cells(r, 3).Value = msg
End If
On Error GoTo 0
End If
End Sub
- 重要ポイント（深掘り）:
- 指摘は1行1問題で具体的に。運用者が直しやすくなる。
- Log出力で監査・再現性を確保。繰り返しの異常も追跡可能。
例題で練習（貼って試せる）
- 例1：必須シート欠如を検出
- ConfigのRequiredSheetsから”Master”を一時削除→InspectWorkbookで”NG: 必須シートなし”が出る。
- 例2：ヘッダー不足を検出
- Inputシートの「電話」ヘッダーを消す→”NG: ヘッダー不足 / 欠如: 電話”が出る。
- 例3：可視性違反を検出
- ConfigをVeryHiddenに戻すべきシートをVisibleに→”NG: 可視性不一致”。
- 例4：名前定義欠如を検出
- API_KEYの名前定義を削除→”NG: 必須の名前定義なし → API_KEY”。
実務の落とし穴と対策（ここが肝）
- 落とし穴1：検査ルールがコード散在
- 対策: Configモジュールに集約。運用変更は定義だけ差し替え。
- 落とし穴2：曖昧な指摘で直せない
- 対策: シート名・項目名・期待値/実値の差分を具体的に出す。
- 落とし穴3：検査が重くて使われない
- 対策: サンプル行で軽量検査。全件チェックは別タスクへ分離。
- 落とし穴4：検査しても自動修復しない
- 対策: 初期は”検査→指摘”で十分。必要なら修復テンプレ（例：ヘッダー自動補填）を段階導入。
- 落とし穴5：人が結果を見逃す
- 対策: 起動時/実行前に必ずInspectを走らせ、NGがあれば処理を停止するフレームに組み込み。
スターター手順（最短導入）
- Config.basを貼る（必須シート・可視性・保護・ヘッダー・名前・テーブル定義）。
- Inspector.basを貼る（InspectWorkbook入口＋各Check関数）。
- 起動時/実行前にInspectWorkbookを呼ぶ（NGがあれば処理を止める）。
- 指摘に応じて修正、必要ならルールを調整（Configだけ変更）。