Excel VBA | フィールド定義表から自動でチェックを組み立てる仕組み(メタデータ駆動)

Excel VBA VBA
スポンサーリンク

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に接続せずに高速に検証できます。

タイトルとURLをコピーしました