Excel VBA 逆引き集 | 実務テンプレ完全版（超再利用部品） – システム間データ変換ツール

Excel VBA
スポンサーリンク

ねらい：異なるシステムの「項目差・形式差・コード差」をマッピング定義で一括変換する

販売管理→会計、EC→WMS、CRM→BIなど、システム間で項目名・コード・日付/数値/通貨/税・改行/文字コードが微妙に違います。VBAなら“変換仕様（マッピング）を宣言→配列で読込→型とコードを正規化→出力レイアウトへ組み替え→検証→書き出し”の型にすると、要件変更にも壊れず、再利用可能な変換ツールになります。初心者でもコピペで動くテンプレを、例題付きでかみ砕いて解説します。

仕様の持ち方：マッピング定義（項目名・型・コード表・式）を宣言する

マッピング構造体（FieldMap と TransformSpec）

' ModTrans_Spec.bas
Option Explicit

Public Type FieldMap
    SrcName As String    ' 入力列名（元システムのヘッダ）
    DstName As String    ' 出力列名（相手システムのヘッダ）
    TypeName As String   ' "text"/"number"/"date"/"code"/"currency"
    CodeTable As String  ' コード変換キー（例："TaxCode","Payment"）
    Formula As String    ' 簡易式（例："qty*price"、"date+7"）
    Required As Boolean  ' 出力側で必須なら True
End Type

Public Type TransformSpec
    SrcSheet As String
    DstSheet As String
    Maps() As FieldMap
End Type

Public Function MakeMap(srcName As String, dstName As String, _
                        typeName As String, Optional codeTable As String = "", _
                        Optional formula As String = "", Optional required As Boolean = False) As FieldMap
    Dim f As FieldMap
    f.SrcName = srcName: f.DstName = dstName
    f.TypeName = typeName: f.CodeTable = codeTable
    f.Formula = formula: f.Required = required
    MakeMap = f
End Function
VB

重要部分の深掘り

  • 変換の「仕様」をコードに埋め込まず、構造体で宣言すると保守が一気に楽になります。Src→Dstの対応、型、コード表、式（派生計算）を1行で表現します。
  • 変換後の必須項目は Required で管理。欠損があれば即エラー化して、正しいデータのみ流す設計が安全です。

共通基盤：配列I/O・型変換・コード表・式評価・書式

ユーティリティ（貼って動く最小セット）

' ModTrans_Base.bas
Option Explicit

Public Function ReadRegion(ws As Worksheet, Optional topLeft As String = "A1") As Variant
    ReadRegion = ws.Range(topLeft).CurrentRegion.Value
End Function

Public Sub WriteBlock(ws As Worksheet, a As Variant, startCell As String)
    ws.Range(startCell).Resize(UBound(a, 1), UBound(a, 2)).Value = a
End Sub

Public Function ColIndex(headers As Variant, name As String) As Long
    Dim c As Long
    For c = 1 To UBound(headers, 2)
        If LCase$(Trim$(CStr(headers(1, c)))) = LCase$(Trim$(name)) Then ColIndex = c: Exit Function
    Next
    ColIndex = 0
End Function

Public Function ToNumberOrZero(v As Variant) As Double
    If IsNumeric(v) Then ToNumberOrZero = CDbl(v) Else ToNumberOrZero = 0#
End Function

Public Function ToDateOrEmpty(v As Variant) As Variant
    If IsDate(v) Then ToDateOrEmpty = CDate(v) Else ToDateOrEmpty = ""
End Function

Public Function NormText(v As Variant) As String
    Dim s As String: s = CStr(v)
    s = StrConv(s, vbNarrow)  ' 全角→半角
    NormText = Trim$(s)
End Function

Public Sub FormatBlock(ws As Worksheet, startCell As String)
    With ws.Range(startCell).CurrentRegion
        .Columns.AutoFit
        .Borders.LineStyle = xlContinuous
    End With
End Sub
VB

重要部分の深掘り

  • 入出力は必ず“配列”で扱い、最後に一括書き戻し。セル逐次だと遅く、エラー時のロールバックも難しくなります。
  • 型の揺らぎ（日付・数値・テキスト）はこの3関数でほぼ解決。入口で正しくしておけば、後工程は単純化できます。

変換ロジック：マッピングに従い、型・コード・式を適用して出力へ

コード表と式評価（簡易）

' ModTrans_CodeEval.bas
Option Explicit

' 簡易コード表：キー→辞書（値変換）
Public Function BuildCodeDict(codeSheet As String, keyName As String) As Object
    ' CodeBookシートに A=TableKey, B=SrcCode, C=DstCode と仮定
    Dim ws As Worksheet: Set ws = Worksheets(codeSheet)
    Dim a As Variant: a = ReadRegion(ws)
    Dim d As Object: Set d = CreateObject("Scripting.Dictionary"): d.CompareMode = 1

    Dim r As Long
    For r = 2 To UBound(a, 1)
        If LCase$(CStr(a(r, 1))) = LCase$(keyName) Then
            Dim src As String: src = LCase$(Trim$(CStr(a(r, 2))))
            Dim dst As String: dst = Trim$(CStr(a(r, 3)))
            d(src) = dst
        End If
    Next
    Set BuildCodeDict = d
End Function

' 簡易式評価（qty*price、date+7、text連結など最低限）
Public Function EvalFormula(formula As String, ByVal rowDict As Object) As Variant
    If Len(formula) = 0 Then EvalFormula = Empty: Exit Function

    Dim f As String: f = LCase$(Replace(formula, " ", ""))
    If InStr(f, "*") > 0 Then
        Dim parts() As String: parts = Split(f, "*")
        EvalFormula = ToNumberOrZero(rowDict(parts(0))) * ToNumberOrZero(rowDict(parts(1)))
    ElseIf InStr(f, "+") > 0 And InStr(f, "date") >= 1 Then
        ' 例: "date+7" → rowDict("date") + 7日
        Dim ps() As String: ps = Split(f, "+")
        EvalFormula = DateAdd("d", CLng(ToNumberOrZero(rowDict(ps(1)))), CDate(rowDict(ps(0))))
    ElseIf InStr(f, "&") > 0 Then
        Dim p2() As String: p2 = Split(f, "&")
        EvalFormula = CStr(rowDict(p2(0))) & CStr(rowDict(p2(1)))
    Else
        EvalFormula = Empty
    End If
End Function
VB

変換本体（貼って動く）

' ModTrans_Run.bas
Option Explicit

Public Sub Transform(ByVal spec As TransformSpec, Optional ByVal codeSheet As String = "CodeBook")
    Dim wsSrc As Worksheet: Set wsSrc = Worksheets(spec.SrcSheet)
    Dim wsDst As Worksheet
    On Error Resume Next: Set wsDst = Worksheets(spec.DstSheet): On Error GoTo 0
    If wsDst Is Nothing Then Set wsDst = Worksheets.Add: wsDst.Name = spec.DstSheet Else wsDst.Cells.Clear

    Dim src As Variant: src = ReadRegion(wsSrc)
    Dim rows As Long: rows = UBound(src, 1)
    Dim cols As Long: cols = UBound(spec.Maps)

    ' 出力配列
    Dim out() As Variant: ReDim out(1 To rows, 1 To cols)
    Dim i As Long: For i = 1 To cols: out(1, i) = spec.Maps(i).DstName: Next

    ' 列名→インデックス
    Dim idx As Object: Set idx = CreateObject("Scripting.Dictionary"): idx.CompareMode = 1
    Dim c As Long: For c = 1 To UBound(src, 2): idx(LCase$(Trim$(CStr(src(1, c))))) = c: Next

    ' コード辞書キャッシュ（CodeTableごと）
    Dim codeCache As Object: Set codeCache = CreateObject("Scripting.Dictionary")
    Dim r As Long
    For r = 2 To rows
        ' 行のキー値辞書（式評価用）
        Dim rowDict As Object: Set rowDict = CreateObject("Scripting.Dictionary"): rowDict.CompareMode = 1
        For c = 1 To UBound(src, 2)
            rowDict(LCase$(Trim$(CStr(src(1, c))))) = src(r, c)
        Next

        Dim colOut As Long: colOut = 1
        Dim f As Long
        For f = 1 To cols
            Dim fm As FieldMap: fm = spec.Maps(f)
            Dim val As Variant

            ' 値取得（元列名で）
            Dim colSrc As Long: colSrc = IIf(Len(fm.SrcName) > 0, ColIndex(src, fm.SrcName), 0)
            Dim raw As Variant: raw = IIf(colSrc > 0, src(r, colSrc), Empty)

            ' 型適用
            Select Case LCase$(fm.TypeName)
                Case "number": val = ToNumberOrZero(raw)
                Case "date": val = ToDateOrEmpty(raw)
                Case "text": val = NormText(raw)
                Case "currency": val = ToNumberOrZero(raw) ' 通貨は数値型で保持（書式は後で適用）
                Case "code"
                    Dim key As String: key = LCase$(fm.CodeTable)
                    If Not codeCache.Exists(key) Then Set codeCache(key) = BuildCodeDict(codeSheet, fm.CodeTable)
                    Dim srcCode As String: srcCode = LCase$(Trim$(CStr(raw)))
                    val = IIf(codeCache(key).Exists(srcCode), codeCache(key)(srcCode), "")
                Case Else: val = raw
            End Select

            ' 式適用（式があれば優先）
            If Len(fm.Formula) > 0 Then
                Dim calc As Variant: calc = EvalFormula(fm.Formula, rowDict)
                If Not IsEmpty(calc) Then val = calc
            End If

            ' 必須チェック（出力側）
            If fm.Required And (VarType(val) = vbEmpty Or Len(Trim$(CStr(val))) = 0) Then
                ' エラー値を明示（空なら "ERROR:REQUIRED"）
                val = "ERROR:REQUIRED"
            End If

            out(r, colOut) = val
            colOut = colOut + 1
        Next
    Next

    WriteBlock wsDst, out, "A1"
    FormatBlock wsDst, "A1"
    ' 日付・数値・通貨の書式（列名で判定）
    Dim j As Long
    For j = 1 To cols
        Dim name As String: name = CStr(out(1, j))
        If InStr(1, LCase$(name), "date") > 0 Then wsDst.Columns(j).NumberFormatLocal = "yyyy-mm-dd"
        If InStr(1, LCase$(name), "amount") > 0 Or InStr(1, LCase$(name), "total") > 0 Or InStr(1, LCase$(name), "price") > 0 Then wsDst.Columns(j).NumberFormatLocal = "#,##0"
    Next
End Sub
VB

重要部分の深掘り

  • マッピングで“型→コード→式→必須”の順に適用。式がある場合は元値より優先（派生列）。
  • コード変換は CodeBook の“テーブル名×SrcCode→DstCode”で複数表を兼用できます。キャッシュ化で高速。
  • 出力は列名の語感で最低限の書式（Date/Amount/Total/Price）を自動付与。現場に合わせてルール追加しやすい設計です。

例題の通し方：EC注文データ→会計仕訳取り込み形式へ変換

仕様宣言と実行（貼って動く）

' ModTrans_Example.bas
Option Explicit

Public Sub Run_Transform_EC_To_GL()
    ' 入力: SrcSheet="EC_Orders"（A=OrderID,B=OrderDate,C=Customer,D=Item,E=Qty,F=Price,G=TaxCode,H=Payment）
    ' 出力: DstSheet="GL_Import"（列例：DocDate, DocNo, Account, Amount, TaxRate, PayMethod, DueDate）

    Dim spec As TransformSpec
    spec.SrcSheet = "EC_Orders"
    spec.DstSheet = "GL_Import"
    ReDim spec.Maps(1 To 7)
    spec.Maps(1) = MakeMap("OrderDate", "DocDate", "date", , , True)
    spec.Maps(2) = MakeMap("OrderID", "DocNo", "text", , , True)
    spec.Maps(3) = MakeMap("", "Account", "code", "AccountMap")       ' 例：固定コード（式なし、CodeBookで"AccountMap"にデフォルト行を用意）
    spec.Maps(4) = MakeMap("", "Amount", "number", , "qty*price", True) ' 税抜金額=数量×単価（行辞書のキーは"qty","price"小文字）
    spec.Maps(5) = MakeMap("TaxCode", "TaxRate", "code", "TaxCode", , True)
    spec.Maps(6) = MakeMap("Payment", "PayMethod", "code", "Payment", , True)
    spec.Maps(7) = MakeMap("OrderDate", "DueDate", "date", , "date+7") ' 納期=注文日+7

    Transform spec, "CodeBook"

    MsgBox "EC→会計フォーマットへの変換が完了しました。", vbInformation
End Sub
VB

補足：CodeBookシートに“TableKey, SrcCode, DstCode”の表を置き、TaxCode/Payment/AccountMapなど複数の行群を持たせます。AccountMapはSrcCode空（または”*”）のデフォルト行を用意すれば、固定値にできます。

検証とエクスポート：必須・型・範囲の軽量チェックとCSV出力

軽量仕様チェック（出力側の破綻検出）

' ModTrans_Validate.bas
Option Explicit

Public Sub ValidateOutput(ByVal dstSheet As String)
    Dim ws As Worksheet: Set ws = Worksheets(dstSheet)
    Dim a As Variant: a = ReadRegion(ws)
    If UBound(a, 1) < 2 Then Exit Sub

    Dim out() As Variant: ReDim out(1 To 1, 1 To 4)
    out(1, 1) = "Row": out(1, 2) = "Field": out(1, 3) = "Issue": out(1, 4) = "Value"
    Dim rowsOut As Long: rowsOut = 1

    Dim r As Long, c As Long
    For r = 2 To UBound(a, 1)
        For c = 1 To UBound(a, 2)
            Dim v As Variant: v = a(r, c)
            Dim name As String: name = CStr(a(1, c))
            ' 必須エラーの印（変換時に "ERROR:REQUIRED" を入れている）
            If CStr(v) = "ERROR:REQUIRED" Then
                rowsOut = rowsOut + 1: ReDim Preserve out(1 To rowsOut, 1 To 4)
                out(rowsOut, 1) = r: out(rowsOut, 2) = name: out(rowsOut, 3) = "Required missing": out(rowsOut, 4) = ""
            End If
            ' 型の簡易検査（例：Amount, Total, Price は数値、Dateは日付）
            If InStr(1, LCase$(name), "date") > 0 And Len(Trim$(CStr(v))) > 0 Then
                If Not IsDate(v) Then
                    rowsOut = rowsOut + 1: ReDim Preserve out(1 To rowsOut, 1 To 4)
                    out(rowsOut, 1) = r: out(rowsOut, 2) = name: out(rowsOut, 3) = "Not date": out(rowsOut, 4) = CStr(v)
                End If
            End If
            If (InStr(1, LCase$(name), "amount") > 0 Or InStr(1, LCase$(name), "total") > 0 Or InStr(1, LCase$(name), "price") > 0) And Len(Trim$(CStr(v))) > 0 Then
                If Not IsNumeric(v) Then
                    rowsOut = rowsOut + 1: ReDim Preserve out(1 To rowsOut, 1 To 4)
                    out(rowsOut, 1) = r: out(rowsOut, 2) = name: out(rowsOut, 3) = "Not number": out(rowsOut, 4) = CStr(v)
                End If
            End If
        Next
    Next

    If rowsOut > 1 Then
        Dim wsE As Worksheet
        On Error Resume Next: Set wsE = Worksheets("TransformErrors"): On Error GoTo 0
        If wsE Is Nothing Then Set wsE = Worksheets.Add: wsE.Name = "TransformErrors" Else wsE.Cells.Clear
        WriteBlock wsE, out, "A1"
        FormatBlock wsE, "A1"
    End If
End Sub
VB

CSV出力（UTF-8、値貼り）

' ModTrans_Export.bas
Option Explicit

Public Sub ExportDstCsv(ByVal dstSheet As String, ByVal csvPath As String)
    Dim ws As Worksheet: Set ws = Worksheets(dstSheet)
    Dim tempWB As Workbook: Set tempWB = Application.Workbooks.Add
    ws.Range("A1").CurrentRegion.Copy
    tempWB.Worksheets(1).Range("A1").PasteSpecial xlPasteValues
    Application.DisplayAlerts = False
    tempWB.SaveAs Filename:=csvPath, FileFormat:=xlCSVUTF8
    Application.DisplayAlerts = True
    tempWB.Close False
End Sub
VB

落とし穴と対策（深掘り）

コード表の漏れ・未定義値で空になる

CodeBookに“デフォルト行（SrcCode=空や*）”を用意し、未定義は安全値へ落とすかエラーにして止めます。変換後に TransformErrors を必ず確認。

式のキー名ズレで計算がゼロに

式は小文字の列名で評価（qty, price, date など）。仕様変更時は EvalFormula のキー名と一致させるルールに。

日付のタイムゾーン・文字列日付

ToDateOrEmptyでDate型に変換し、書式は“yyyy-mm-dd”固定。外部システムがタイムスタンプを要求する場合は、派生列で時刻を追加（date&” 00:00:00″）する運用に。

通貨・桁・丸めのズレ

内部は数値で保持し、丸めは外部仕様に合わせてExport前に適用（Round関数）。通貨記号はCSVには入れず、見た目は受け側で定義。

セル逐次処理で遅い

必ず“配列→一括書き戻し”。辞書キャッシュ（コード表）はテーブル単位で使い回し、高速化します。

まとめ：マッピング宣言→型・コード・式→検証→出力の型で「壊れない変換」を作る

変換仕様をFieldMapで宣言し、配列で入力を掴み、型正規化・コード変換・式計算を順に適用、必須をチェックしてから出力。軽量検証とCSV出力までをひとつの流れにすると、相手システムに“毎回同じ品質”で渡せます。

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