Excel VBA 逆引き集 | 依存性注入（DI風）

Excel VBA
スポンサーリンク
  1. ねらい：Excel VBAで「依存性注入（DI風）」を取り入れ、差し替えやすく壊れにくい設計にする
    1. 重要ポイントの深掘り
  2. 基本構造：契約を固定し、具体実装を外から渡す
    1. 抽象ベースクラスで「契約（読み・書き）」を表現する
    2. 具体実装は「どこから・どう読み書きするか」を担当する
  3. DI風の注入方法：サービスに依存を「外から渡す」
    1. サービスクラスは契約に依存し、具体はプロパティやInitで受け取る
    2. 重要ポイントの深掘り
  4. 入口と注入のパターン：どこで具体を作り、どう渡すか
    1. 標準モジュール（Entry）で具体を作り、サービスへ渡す
    2. Configから注入する構成（運用差異をコード変更なしで吸収）
  5. モック注入でテストする：入出力なしでロジック検証
    1. テスト用Repository（モック）を注入し、処理結果を確認する
    2. 重要ポイントの深掘り
  6. 運用品質の枠を組み合わせる：開始・終了、進捗、ログ
    1. 開始・終了の共通枠で「失敗しても戻る」設計にする
    2. 進捗・ログはサービスで統一管理する
  7. 例題の流れ：保存先を切り替えて同じロジックを動かす
    1. シート版からCSV版に切り替えるだけで同じ結果を得る
    2. ConfigでREPO_TYPEを変更し、コード変更なしで運用切り替えする
  8. 深掘り：DI風設計で避けられる落とし穴
    1. 具体クラスに直接依存して差し替え不能になる問題
    2. テストが外部I/Oに引きずられる問題
    3. 依存が循環して壊れやすくなる問題
  9. 導入手順：今日からDI風にする最短ルート
    1. ステップ1：契約（IRepository）を作る
    2. ステップ2：保存先ごとの具体Repositoryを1つ作る
    3. ステップ3：サービスを契約に依存させ、Initで注入する
    4. ステップ4：モックを用意してロジックをテストする
    5. ステップ5：Configからの注入に拡張する
  10. まとめ：VBAでも「外から渡す」だけでDIのメリットは十分に得られる

ねらい：Excel VBAで「依存性注入（DI風）」を取り入れ、差し替えやすく壊れにくい設計にする

依存性注入（DI）は「使う側が必要な部品を自分で作らず、外から渡してもらう」設計です。VBAにはDIコンテナはありませんが、クラスのコンストラクタ代わりの初期化メソッドやプロパティで依存を渡せば、DI風の効果を得られます。保存先がシート・テーブル・CSVに変わっても、呼ぶ側（サービス）は差し替えだけで動き、テストも楽になります。

重要ポイントの深掘り

VBAでDI風にする要点は「依存を直接newしない」「契約（インターフェース相当）に依存する」「初期化メソッドで外部から渡す」の3つです。これにより、部品の入れ替え・テストダブル（モック）差し替え・運用差異への対応が、最小修正で可能になります。さらに、開始・終了の共通枠と配列I/Oを組み合わせることで、速度・安定性・保守性が同時に向上します。

基本構造：契約を固定し、具体実装を外から渡す

抽象ベースクラスで「契約（読み・書き）」を表現する

VBAに正式なインターフェース構文はありません。そこで抽象ベースクラス（未実装のメソッドがErr.Raiseするクラス）を用意して、呼ぶ側はこの契約に依存します。

' IRepository.cls（抽象：読み込み・保存の契約）
Option Explicit

Public Function LoadAll() As Variant
    Err.Raise 9000, , "Not implemented"
End Function

Public Sub SaveAll(ByVal data As Variant)
    Err.Raise 9001, , "Not implemented"
End Sub
VB

具体実装は「どこから・どう読み書きするか」を担当する

シート版、テーブル(ListObject)版、CSV版など、保存先ごとに具体クラスを用意します。契約の形（配列の入出力）は揃えます。

' SheetRepository.cls
Option Explicit
Private ws As Worksheet
Private anchor As String

Public Sub Init(ByVal target As Worksheet, ByVal topLeft As String)
    Set ws = target: anchor = topLeft
End Sub

Public Function LoadAll() As Variant
    LoadAll = ws.Range(anchor).CurrentRegion.Value
End Function

Public Sub SaveAll(ByVal data As Variant)
    ws.Range(anchor).Resize(UBound(data, 1), UBound(data, 2)).Value = data
End Sub
VB
' TableRepository.cls
Option Explicit
Private lo As ListObject

Public Sub Init(ByVal target As ListObject)
    Set lo = target
End Sub

Public Function LoadAll() As Variant
    LoadAll = lo.DataBodyRange.Value
End Function

Public Sub SaveAll(ByVal data As Variant)
    lo.DataBodyRange.Resize(UBound(data, 1), UBound(data, 2)).Value = data
End Sub

Public Function IndexOf(ByVal colName As String) As Long
    IndexOf = lo.ListColumns(colName).Index
End Function
VB
' CsvRepository.cls（UTF-8で保存・読込）
Option Explicit
Private path As String

Public Sub Init(ByVal csvPath As String)
    path = csvPath
End Sub

Public Function LoadAll() 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: Set st = Nothing
    Dim lines() As String: lines = Split(text, vbCrLf)
    If UBound(lines) < 0 Then Exit Function

    Dim head() As String: head = ParseCsvLine(lines(0))
    Dim cols As Long: cols = UBound(head) + 1
    Dim arr() As Variant: ReDim arr(1 To UBound(lines) + 1, 1 To cols)

    Dim c As Long: For c = 1 To cols: arr(1, c) = head(c - 1): Next
    Dim r As Long
    For r = 2 To UBound(lines) + 1
        If Len(lines(r - 1)) = 0 Then Exit For
        Dim rec() As String: rec = ParseCsvLine(lines(r - 1))
        For c = 1 To cols: arr(r, c) = IIf(c - 1 <= UBound(rec), rec(c - 1), ""): Next
    Next
    LoadAll = arr
End Function

Public Sub SaveAll(ByVal data As Variant)
    Dim st As Object: Set st = CreateObject("ADODB.Stream")
    st.Type = 2: st.Charset = "UTF-8": st.Open
    Dim r As Long, c As Long, line As String
    For r = 1 To UBound(data, 1)
        line = ""
        For c = 1 To UBound(data, 2)
            Dim s As String: s = Replace(CStr(data(r, c)), """", """""")
            line = line & IIf(c > 1, ",", "") & """" & s & """"
        Next
        st.WriteText line & vbCrLf
    Next
    st.SaveToFile path, 2
    st.Close: Set st = Nothing
End Sub

Private Function ParseCsvLine(ByVal line As String) As String()
    Dim res() As String, buf As String, i As Long, inQ As Boolean
    ReDim res(0 To 0)
    For i = 1 To Len(line)
        Dim ch As String: ch = Mid$(line, i, 1)
        If ch = """" Then
            If inQ And i < Len(line) And Mid$(line, i + 1, 1) = """" Then
                buf = buf & """": i = i + 1
            Else
                inQ = Not inQ
            End If
        ElseIf ch = "," And Not inQ Then
            res(UBound(res)) = buf: buf = "": ReDim Preserve res(0 To UBound(res) + 1)
        Else
            buf = buf & ch
        End If
    Next
    res(UBound(res)) = buf
    ParseCsvLine = res
End Function
VB

DI風の注入方法：サービスに依存を「外から渡す」

サービスクラスは契約に依存し、具体はプロパティやInitで受け取る

サービス（業務フロー）は IRepository にだけ依存します。外部から具体Repositoryを渡してもらい、業務処理を実行します。これがDI風の核です。

' EmployeeService.cls
Option Explicit

Private repo As IRepository
Private threshold As Double

Public Sub Init(ByVal repository As IRepository, ByVal th As Double)
    Set repo = repository
    threshold = th
End Sub

Public Sub RunPass(ByVal wsOut As Worksheet)
    On Error GoTo EH
    AppEnter "合格判定"

    Dim data As Variant: data = repo.LoadAll
    RequireHeaders data, Array("EmpNo", "Name", "Dept", "Score")

    Dim idxScore As Long: idxScore = IndexByHeader(data, "Score")
    Dim rows As Long: rows = UBound(data, 1)
    Dim cols As Long: cols = UBound(data, 2)

    Dim out() As Variant: ReDim out(1 To rows, 1 To cols + 1)
    Dim c As Long: For c = 1 To cols: out(1, c) = data(1, c): Next
    out(1, cols + 1) = "Pass"

    Dim r As Long
    For r = 2 To rows
        For c = 1 To cols: out(r, c) = data(r, c): Next
        out(r, cols + 1) = IIf(CDbl(data(r, idxScore)) >= threshold, "○", "×")
    Next

    wsOut.Range("A1").Resize(rows, cols + 1).Value = out

    AppLeave
    MsgBox "完了（" & rows - 1 & "件）"
    Exit Sub
EH:
    AppLeave
    MsgBox "失敗: " & Err.Description, vbExclamation
End Sub
VB
' ModHeaderMap.bas（ヘッダー検証と取得）
Option Explicit
Public Function IndexByHeader(ByVal data As Variant, ByVal headerName As String) As Long
    Dim cols As Long: cols = UBound(data, 2)
    Dim j As Long
    For j = 1 To cols
        If StrComp(CStr(data(1, j)), headerName, vbTextCompare) = 0 Then
            IndexByHeader = j: Exit Function
        End If
    Next
    Err.Raise 9100, , "ヘッダーが見つかりません: " & headerName
End Function

Public Sub RequireHeaders(ByVal data As Variant, ByVal headers As Variant)
    Dim i As Long
    For i = LBound(headers) To UBound(headers)
        Call IndexByHeader(data, CStr(headers(i)))
    Next
End Sub
VB

重要ポイントの深掘り

サービスが具体クラスをnewしないことで、保存先の差し替えが容易になります。テスト時にはモック（テスト用のIRepository実装）を渡すことで、入出力なしでロジックだけ検証できます。VBAでも「外から渡す」だけでDIの実用的なメリットが得られます。

入口と注入のパターン：どこで具体を作り、どう渡すか

標準モジュール（Entry）で具体を作り、サービスへ渡す

入口Run_XXXXで実際の保存先に応じたRepositoryをnewし、Initでサービスに注入します。切り替えは1行です。

' ModEntry.bas
Option Explicit

Public Sub Run_Pass_Sheet()
    Dim r As New SheetRepository
    r.Init Worksheets("Input"), "A1"

    Dim svc As New EmployeeService
    svc.Init r, 70#
    svc.RunPass Worksheets("Output")
End Sub

Public Sub Run_Pass_Table()
    Dim r As New TableRepository
    r.Init Worksheets("Input").ListObjects("tblEmployees")

    Dim svc As New EmployeeService
    svc.Init r, 70#
    svc.RunPass Worksheets("Output")
End Sub

Public Sub Run_Pass_Csv()
    Dim r As New CsvRepository
    r.Init ThisWorkbook.Path & "\employees.csv"

    Dim svc As New EmployeeService
    svc.Init r, 70#
    svc.RunPass Worksheets("Output")
End Sub
VB

Configから注入する構成（運用差異をコード変更なしで吸収）

Configの「REPO_TYPE」を読み、対応する具体を選んで注入します。運用現場の切り替えはConfigだけです。

' ModInjector.bas
Option Explicit

Public Function BuildRepositoryFromConfig() As IRepository
    Dim t As String: t = GetConfigString("REPO_TYPE") ' "SHEET" / "TABLE" / "CSV"
    Select Case UCase$(t)
        Case "SHEET"
            Dim rs As New SheetRepository
            rs.Init Worksheets(GetConfigString("INPUT_SHEET")), GetConfigString("ANCHOR")
            Set BuildRepositoryFromConfig = rs
        Case "TABLE"
            Dim rt As New TableRepository
            rt.Init Worksheets(GetConfigString("INPUT_SHEET")).ListObjects(GetConfigString("TABLE_NAME"))
            Set BuildRepositoryFromConfig = rt
        Case "CSV"
            Dim rc As New CsvRepository
            rc.Init GetConfigString("CSV_PATH")
            Set BuildRepositoryFromConfig = rc
        Case Else
            Err.Raise 9500, , "未知のREPO_TYPE: " & t
    End Select
End Function
VB
' ModConfig.bas（キー読み取り）
Option Explicit
Private Function ConfigSheet() As Worksheet: Set ConfigSheet = ThisWorkbook.Worksheets("Config"): End Function
Public Function GetConfigString(ByVal key As String) As String
    Dim ws As Worksheet: Set ws = ConfigSheet()
    Dim last As Long: last = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Dim r As Long
    For r = 2 To last
        If StrComp(CStr(ws.Cells(r, "A").Value), key, vbTextCompare) = 0 Then
            GetConfigString = Trim$(CStr(ws.Cells(r, "B").Value))
            Exit Function
        End If
    Next
    Err.Raise 900, , "Configキーが見つかりません: " & key
End Function
VB

モック注入でテストする：入出力なしでロジック検証

テスト用Repository（モック）を注入し、処理結果を確認する

モックは固定の配列を返し、保存は何もしません。サービスの配列処理だけを安全に検証できます。

' MockRepository.cls
Option Explicit

Public Function LoadAll() As Variant
    Dim a(1 To 3, 1 To 4) As Variant
    a(1, 1) = "EmpNo": a(1, 2) = "Name": a(1, 3) = "Dept": a(1, 4) = "Score"
    a(2, 1) = "000001": a(2, 2) = "山田": a(2, 3) = "Sales": a(2, 4) = 80
    a(3, 1) = "000002": a(3, 2) = "佐藤": a(3, 3) = "HR":    a(3, 4) = 60
    LoadAll = a
End Function

Public Sub SaveAll(ByVal data As Variant)
    ' 何もしない（テスト用）
End Sub
VB
' ModTest.bas
Option Explicit
Public Sub Test_RunPass_WithMock()
    Dim m As New MockRepository
    Dim svc As New EmployeeService
    svc.Init m, 70#
    svc.RunPass Worksheets("Output") ' OutputにPass列が出る
End Sub
VB

重要ポイントの深掘り

テスト時に外部I/Oを切り離せるのがDIの大きな利点です。モックが返す配列でロジックの期待結果を確認し、速度・安定性を保ちつつ、入出力の不確実性（ネットワーク・ファイルロック）を排除して検証できます。

運用品質の枠を組み合わせる：開始・終了、進捗、ログ

開始・終了の共通枠で「失敗しても戻る」設計にする

開始時に描画・イベント・再計算を止め、終了時に必ず復帰します。サービスの入口で徹底します。

' ModApp.bas
Option Explicit
Public Sub AppEnter(Optional ByVal status As String = "")
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    If Len(status) > 0 Then Application.StatusBar = status
End Sub
Public Sub AppLeave()
    Application.StatusBar = False
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
VB

進捗・ログはサービスで統一管理する

DoEventsの呼びすぎは遅くなります。1〜5%刻みで間引き表示し、Start/Finish/Errorのログを残すと、現場の不安が減り、調査が速くなります。DIと組み合わせることで、保存先を変えても運用品質は一貫します。

例題の流れ：保存先を切り替えて同じロジックを動かす

シート版からCSV版に切り替えるだけで同じ結果を得る

Run_Pass_Sheet と Run_Pass_Csv をそれぞれ実行します。Outputシートには同じヘッダー＋Pass列が出力されます。サービスは契約にしか依存していないため、差し替えの影響は入口1箇所だけです。

ConfigでREPO_TYPEを変更し、コード変更なしで運用切り替えする

ConfigのREPO_TYPEを SHEET→TABLE→CSV と変え、Run_Pass_Config を作って BuildRepositoryFromConfig 経由で注入します。運用現場はConfigのキー変更だけで切り替えできます。

' ModEntryConfig.bas
Option Explicit
Public Sub Run_Pass_Config()
    Dim repo As IRepository
    Set repo = BuildRepositoryFromConfig()

    Dim svc As New EmployeeService
    svc.Init repo, CDbl(GetConfigString("THRESHOLD"))
    svc.RunPass Worksheets(GetConfigString("OUTPUT_SHEET"))
End Sub
VB

深掘り：DI風設計で避けられる落とし穴

具体クラスに直接依存して差し替え不能になる問題

サービスが SheetRepository を直接newすると、保存先変更のたびにサービスを書き換える必要が出ます。契約（IRepository）に依存し、具体は外から渡す形にすれば、差し替えは入口だけで済みます。

テストが外部I/Oに引きずられる問題

外部の状態（ファイル、ネットワーク、列順）に依存すると、テストが不安定になりがちです。モック注入すれば、配列ベースのロジックだけを短時間で繰り返し検証できます。

依存が循環して壊れやすくなる問題

サービス→Repository→サービスのような循環を作らないこと。依存は一方向に保ち、責務を混ぜない（Repositoryに業務ルールを書かない、サービスに入出力詳細を持ち込まない）ことで、修正範囲が自然に限定されます。

導入手順：今日からDI風にする最短ルート

ステップ1：契約（IRepository）を作る

抽象ベースクラスに LoadAll/SaveAll を定義し、戻り値は「ヘッダー付き二次元配列」に統一します。

ステップ2：保存先ごとの具体Repositoryを1つ作る

最初はシート版（CurrentRegion）で十分。配列I/Oに統一して速度を確保します。

ステップ3：サービスを契約に依存させ、Initで注入する

サービスで具体をnewしない。入口で具体を作り、Init経由で渡します。

ステップ4：モックを用意してロジックをテストする

固定配列を返すMockRepositoryで、入出力なしの検証を行います。

ステップ5：Configからの注入に拡張する

REPO_TYPEやシート名・テーブル名・CSVパスをConfigへ置き、BuildRepositoryFromConfigで選択・注入します。

まとめ：VBAでも「外から渡す」だけでDIのメリットは十分に得られる

依存性注入（DI風）は、保存先・連携先・運用差異の変更を「入口の差し替えだけ」に局所化し、サービスとロジックを無傷で保ちます。VBAでは、抽象ベースクラスの契約、Init/プロパティ注入、Config選択、モックテストの4点で実用的に運用できます。

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