DB定義をキャッシュして毎回接続せずに使うバージョン
これまでの「DBから定義を読み込む」方式は、毎回接続して定義を取得していました。
実務では 定義は頻繁に変わらない ので、最初に読み込んで キャッシュ(メモリに保持) しておき、以降はそれを使う方が効率的です。
キャッシュの考え方
- 初回実行時:DBに接続して定義を読み込み、グローバル変数に保存。
- 2回目以降:DBには接続せず、キャッシュ済みの定義を利用。
- 定義を更新したいとき:キャッシュをクリアする関数を呼び出す。
VBAコード例
' ===== モジュールレベル変数 =====
Option Explicit
Private g_FieldDefs As Collection ' キャッシュ用
' --- 定義をDBから読み込む(初回のみ) ---
Function GetFieldDefinitions() As Collection
If g_FieldDefs Is Nothing Then
Dim conn As Object, rs As Object, sql As String
Set g_FieldDefs = New Collection
' DB接続(例:Access)
Set conn = CreateObject("ADODB.Connection")
conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\FieldDef.accdb;"
sql = "SELECT 列番号, 項目名, 必須, 型, 最小値, 最大値, 最大文字数, 正規表現 FROM FieldDefinitions"
Set rs = CreateObject("ADODB.Recordset")
rs.Open sql, conn
Do Until rs.EOF
g_FieldDefs.Add Array(rs(0).Value, rs(1).Value, rs(2).Value, rs(3).Value, _
rs(4).Value, rs(5).Value, rs(6).Value, rs(7).Value)
rs.MoveNext
Loop
rs.Close
conn.Close
End If
Set GetFieldDefinitions = g_FieldDefs
End Function
' --- キャッシュをクリアする ---
Sub ClearFieldDefCache()
Set g_FieldDefs = Nothing
MsgBox "フィールド定義キャッシュをクリアしました。次回はDBから再取得します。", vbInformation
End Sub
' --- 検証処理 ---
Sub ValidateByCachedDefinition()
Dim wsData As Worksheet, wsReport As Worksheet
Dim lastRow As Long, r As Long, output As Long
Dim defs As Collection, def As Variant
Dim value As Variant, errs As Variant, msg As String
Set wsData = ThisWorkbook.Sheets("Sheet1")
' 出力先シート準備
On Error Resume Next
Set wsReport = ThisWorkbook.Sheets("検証結果")
On Error GoTo 0
If wsReport Is Nothing Then
Set wsReport = ThisWorkbook.Sheets.Add
wsReport.Name = "検証結果"
Else
wsReport.Cells.Clear
End If
wsReport.Range("A1:E1").Value = Array("行番号", "列番号", "項目名", "値", "エラー内容")
output = 2
' --- キャッシュから定義を取得 ---
Set defs = GetFieldDefinitions()
lastRow = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row
For r = 2 To lastRow
For Each def In defs
Dim colIdx As Long, fieldName As String, required As Boolean
Dim fieldType As String, minVal As String, maxVal As String
Dim maxLen As Long, regex As String
colIdx = CLng(def(0))
fieldName = def(1)
required = (def(2) = "○")
fieldType = def(3)
minVal = def(4)
maxVal = def(5)
If def(6) <> "" Then maxLen = CLng(def(6)) Else maxLen = 0
regex = def(7)
value = wsData.Cells(r, colIdx).Value
errs = CollectErrors( _
IIf(required, CheckRequired(value, fieldName), ""), _
IIf(maxLen > 0, CheckMaxLength(value, fieldName, maxLen), ""), _
IIf(fieldType = "整数", CheckInteger(value, fieldName), _
IIf(fieldType = "数値", CheckNumber(value, fieldName), _
IIf(fieldType = "日付", CheckDate(value, fieldName), ""))), _
IIf(fieldType = "整数" Or fieldType = "数値", CheckNumberRange(value, fieldName, minVal, maxVal), ""), _
IIf(fieldType = "日付", CheckDateRange(value, fieldName, minVal, IIf(maxVal = "TODAY", Date, maxVal)), ""), _
IIf(regex <> "", CheckRegex(value, fieldName, regex, ""), "") _
)
msg = JoinErrors(errs)
If msg <> "" Then
wsReport.Cells(output, "A").Value = r
wsReport.Cells(output, "B").Value = colIdx
wsReport.Cells(output, "C").Value = fieldName
wsReport.Cells(output, "D").Value = value
wsReport.Cells(output, "E").Value = msg
wsReport.Cells(output, "E").WrapText = True
output = output + 1
End If
Next def
Next r
MsgBox "キャッシュ定義に基づく検証が完了しました。エラー件数: " & (output - 2), vbInformation
End Sub
VBポイント
g_FieldDefsをモジュールレベル変数にしてキャッシュ。- 初回のみDB接続 → 以降はキャッシュを利用。
- ClearFieldDefCache を呼べば再取得可能。
- TODAY のような特殊値も前回と同じ処理で対応。
応用アイデア
- キャッシュを「Dictionary」にして項目名でアクセスできるようにする。
- キャッシュをJSONやXMLに書き出して、次回起動時に即ロード。
- 定義の更新日時をDBに持たせて、キャッシュと比較して自動リフレッシュ。
👉 この仕組みを使えば、毎回DBに接続せずに高速に検証できます。


