Excel VBA 逆引き集 | 実務テンプレ完全版(超再利用部品) – マスタ加工一括ツール

Excel VBA
スポンサーリンク

ねらい:顧客マスタ・商品マスタなどを「正規化→名寄せ→項目追加→エクスポート」まで一括で加工する

マスタは、一度“型を決めて整えておく”と、その後の全ての業務(受発注・売上・分析)が安定します。
一方で、現場の原本は「表記揺れ」「不要列の混在」「列構成の違い」「ID未付番」「カテゴリ未設定」などバラバラです。

ここでは、

  1. 正規化(文字揺れ・スペース・全半角)
  2. 型統一(数値・日付)
  3. 名寄せ(重複キーの統合)
  4. 項目の一括追加(ID採番・カテゴリ付与・フラグ)
  5. エクスポート(別システム用への出力)

までを、ひとつの“マスタ加工一括ツール”として組むテンプレを、例題付きで解説します。
「顧客マスタ」と「商品マスタ」の両方に使えるような“超再利用部品”として作ります。


共通基盤:配列I/O・正規化・ID採番のユーティリティ

基本ユーティリティ(全マスタ共通で使い回す)

' ModMaster_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 Sub FormatBlock(ws As Worksheet, startCell As String)
    With ws.Range(startCell).CurrentRegion
        .Columns.AutoFit
        .Borders.LineStyle = xlContinuous
    End With
End Sub

Public Function NormText(ByVal v As Variant) As String
    Dim s As String
    s = CStr(v)
    s = StrConv(s, vbNarrow)          ' 全角→半角
    s = Replace(s, " ", " ")         ' 全角スペース→半角
    s = Trim$(s)                      ' 前後スペース除去
    NormText = s
End Function

Public Function NormKey(ByVal v As Variant) As String
    Dim s As String
    s = NormText(v)
    s = LCase$(s)                     ' 小文字化
    NormKey = s
End Function

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

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

Public Function ColumnIndex(ByVal headers As Variant, ByVal 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
            ColumnIndex = c
            Exit Function
        End If
    Next
    ColumnIndex = 0
End Function

Public Function NextCode(ByVal prefix As String, ByVal seq As Long, Optional ByVal digits As Long = 5) As String
    NextCode = prefix & Format$(seq, String$(digits, "0"))
End Function
VB

ここが“土台”です。

正規化は NormText と NormKey の二段階に分けています。
NormText は見た目を整える(全角→半角、スペース整理)。
NormKey はキーとして使う想定なので、小文字化まで入れます。

ID採番用の NextCode は、「C00001」「P00001」のようなコードを簡単に作るための部品です。


顧客マスタ加工:正規化→名寄せ→ID採番→フラグ付与

ここでは、元データが次のようなイメージだとします。

A=顧客名
B=顧客名カナ
C=郵便番号
D=住所
E=電話番号
F=メールアドレス

そして、やりたいことは次です。

顧客名・住所・電話の揺れを正して名寄せする。
顧客IDを新規採番する。
「法人/個人」フラグを付ける。
「メールアドレスあり/なし」フラグを付ける。

顧客マスタの加工本体

' ModMaster_Customer.bas
Option Explicit

Public Sub ProcessCustomerMaster(ByVal sheetName As String, ByVal outStart As String)
    Dim ws As Worksheet
    Set ws = Worksheets(sheetName)

    Dim src As Variant
    src = ReadRegion(ws)
    
    Dim lastCol As Long
    lastCol = UBound(src, 2)
    
    Dim out() As Variant
    ReDim out(1 To UBound(src, 1), 1 To lastCol + 4)
    
    Dim r As Long, c As Long
    
    out(1, 1) = "CustomerID"
    For c = 1 To lastCol
        out(1, c + 1) = src(1, c)
    Next
    out(1, lastCol + 2) = "CustomerType"
    out(1, lastCol + 3) = "HasEmail"
    out(1, lastCol + 4) = "NormKey"
    
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = 1
    
    Dim seq As Long
    seq = 0
    
    For r = 2 To UBound(src, 1)
        Dim name As String
        Dim addr As String
        Dim phone As String
        
        name = NormKey(src(r, 1))
        addr = NormKey(src(r, 4))
        phone = NormKey(src(r, 5))
        
        Dim key As String
        key = name & "|" & addr & "|" & phone
        
        Dim custID As String
        
        If dict.Exists(key) Then
            custID = dict(key)
        Else
            seq = seq + 1
            custID = NextCode("C", seq, 5)
            dict(key) = custID
        End If
        
        out(r, 1) = custID
        
        For c = 1 To lastCol
            If c = 1 Then
                out(r, c + 1) = NormText(src(r, c))
            ElseIf c = 4 Then
                out(r, c + 1) = NormText(src(r, c))
            ElseIf c = 5 Then
                out(r, c + 1) = NormText(src(r, c))
            ElseIf c = 6 Then
                out(r, c + 1) = LCase$(Trim$(CStr(src(r, c))))
            Else
                out(r, c + 1) = src(r, c)
            End If
        Next
        
        Dim rawName As String
        rawName = CStr(src(r, 1))
        Dim custType As String
        If InStr(rawName, "株式会社") > 0 Or InStr(rawName, "(株)") > 0 Or InStr(rawName, "(株)") > 0 Or InStr(rawName, "有限会社") > 0 Or InStr(rawName, "合同会社") > 0 Then
            custType = "法人"
        Else
            custType = "個人"
        End If
        
        Dim mail As String
        mail = LCase$(Trim$(CStr(src(r, 6))))
        Dim hasEmail As String
        If Len(mail) > 0 And InStr(mail, "@") > 0 Then
            hasEmail = "Y"
        Else
            hasEmail = "N"
        End If
        
        out(r, lastCol + 2) = custType
        out(r, lastCol + 3) = hasEmail
        out(r, lastCol + 4) = key
    Next
    
    WriteBlock ws, out, outStart
    FormatBlock ws, outStart
End Sub
VB

重要なポイントを整理します。

名寄せキーは「顧客名+住所+電話」を正規化したものを結合しています。
ここで NormKey を通すことで、「株式会社」「(株)」「スペース違い」「大小文字差」などの揺れを吸収しやすくなります。

顧客IDは Dictionary で“すでに見たキー”に対して同じIDを返すことで、重複レコードが同じIDを持つようにしています。
これは“1顧客に複数行ある”ケース(支店、複数の連絡先など)でも、顧客IDで束ねられるようにするためです。

法人/個人判定は簡易ですが、「株式会社」「有限会社」「合同会社」などを含むかどうかで分けています。
HasEmail は実務でよく使う「メール連絡可能か」を Y/N で持っています。これがあるだけで、マーケや通知系のフィルタが一気に楽になります。


商品マスタ加工:正規化→カテゴリ付与→価格帯フラグ→ID採番

次は商品マスタです。

元データは次のような前提にします。

A=商品名
B=商品コード(あれば)
C=カテゴリ名(あいまい)
D=標準価格
E=仕入価格

やりたいことは次の通りです。

商品名の正規化(スペース・全半角など)。
カテゴリ呼称の統一(「ノートPC」「ノートパソコン」など)。
価格帯フラグ(高単価・中価格・低価格など)。
商品IDを採番(商品コードがない場合の補完)。

カテゴリマッピングと価格帯ロジック

' ModMaster_Product.bas
Option Explicit

Private Function MapCategory(ByVal rawCat As String) As String
    Dim s As String
    s = LCase$(NormText(rawCat))
    
    If s Like "*pc*" Or s Like "*パソコン*" Or s Like "*ノート*" Then
        MapCategory = "PC"
    ElseIf s Like "*プリンタ*" Or s Like "*printer*" Then
        MapCategory = "Printer"
    ElseIf s Like "*サーバ*" Or s Like "*server*" Then
        MapCategory = "Server"
    Else
        MapCategory = "Other"
    End If
End Function

Private Function PriceBand(ByVal price As Double) As String
    If price <= 0 Then
        PriceBand = "Unknown"
    ElseIf price < 10000 Then
        PriceBand = "Low"
    ElseIf price < 50000 Then
        PriceBand = "Mid"
    Else
        PriceBand = "High"
    End If
End Function
VB

ここで、カテゴリ名の揺らぎを「PC」「Printer」「Server」などにまとめるロジックを持たせています。
実務では、別シートのマスタを参照しても良いですが、最初は Like を使ったベタ書きの方が簡単です。

価格帯は、「価格の目安で分けたい」という現場によくある要望を、簡単な閾値で実装しています。

商品マスタ加工本体

Public Sub ProcessProductMaster(ByVal sheetName As String, ByVal outStart As String)
    Dim ws As Worksheet
    Set ws = Worksheets(sheetName)
    
    Dim src As Variant
    src = ReadRegion(ws)
    
    Dim lastCol As Long
    lastCol = UBound(src, 2)
    
    Dim out() As Variant
    ReDim out(1 To UBound(src, 1), 1 To lastCol + 4)
    
    Dim r As Long, c As Long
    
    out(1, 1) = "ProductID"
    For c = 1 To lastCol
        out(1, c + 1) = src(1, c)
    Next
    out(1, lastCol + 2) = "NormCategory"
    out(1, lastCol + 3) = "PriceBand"
    out(1, lastCol + 4) = "NormNameKey"
    
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = 1
    
    Dim seq As Long
    seq = 0
    
    For r = 2 To UBound(src, 1)
        Dim name As String
        name = NormKey(src(r, 1))
        
        Dim existingCode As String
        existingCode = Trim$(CStr(src(r, 2)))
        
        Dim key As String
        key = name
        
        Dim prodID As String
        
        If Len(existingCode) > 0 Then
            prodID = existingCode
        Else
            If dict.Exists(key) Then
                prodID = dict(key)
            Else
                seq = seq + 1
                prodID = NextCode("P", seq, 5)
                dict(key) = prodID
            End If
        End If
        
        out(r, 1) = prodID
        
        For c = 1 To lastCol
            If c = 1 Then
                out(r, c + 1) = NormText(src(r, c))
            ElseIf c = 3 Then
                out(r, c + 1) = NormText(src(r, c))
            ElseIf c = 4 Or c = 5 Then
                out(r, c + 1) = ToNumberOrZero(src(r, c))
            Else
                out(r, c + 1) = src(r, c)
            End If
        Next
        
        Dim rawCat As String
        rawCat = CStr(src(r, 3))
        Dim normCat As String
        normCat = MapCategory(rawCat)
        
        Dim price As Double
        price = ToNumberOrZero(src(r, 4))
        Dim band As String
        band = PriceBand(price)
        
        out(r, lastCol + 2) = normCat
        out(r, lastCol + 3) = band
        out(r, lastCol + 4) = name
    Next
    
    WriteBlock ws, out, outStart
    FormatBlock ws, outStart
    ws.Columns(1).NumberFormatLocal = "@"
    ws.Columns(4 + 1).NumberFormatLocal = "#,##0"
    ws.Columns(5 + 1).NumberFormatLocal = "#,##0"
End Sub
VB

ここでの重要なポイントです。

既存の商品コードがすでにある場合は、それを ProductID として採用します。
ない場合だけ、正規化した商品名(NormNameKey)で Dictionary を参照し、なければ新たに採番します。

カテゴリ名を NormCategory として標準化し、PriceBand で価格帯フラグを付けることで、
「カテゴリ別×価格帯別」といった切り口での分析やフィルタが一瞬でできるようになります。

価格・仕入価格は ToNumberOrZero で数値化しているので、文字列数値が混ざっていても集計が壊れません。


マスタ共通処理:不要列削除・列並び替え・別システム用フォーマットへエクスポート

実務では、「加工したマスタを別システムの取り込み形式に合わせたい」という要望がほぼ必ず出ます。
ここでは、「加工済みマスタから、必要な列だけ順番を並べ替えて別シートに出力する」テンプレを用意します。

列選択・並び替えテンプレ

' ModMaster_Export.bas
Option Explicit

Public Sub ExportMasterLayout(ByVal srcSheet As String, ByVal dstSheet As String, ByVal fieldOrder As Variant)
    Dim wsSrc As Worksheet
    Set wsSrc = Worksheets(srcSheet)
    
    Dim wsDst As Worksheet
    On Error Resume Next
    Set wsDst = Worksheets(dstSheet)
    On Error GoTo 0
    If wsDst Is Nothing Then
        Set wsDst = Worksheets.Add
        wsDst.Name = dstSheet
    Else
        wsDst.Cells.Clear
    End If
    
    Dim src As Variant
    src = ReadRegion(wsSrc)
    
    Dim out() As Variant
    Dim rows As Long
    Dim cols As Long
    
    rows = UBound(src, 1)
    cols = UBound(fieldOrder)
    
    ReDim out(1 To rows, 1 To cols)
    
    Dim c As Long
    For c = 1 To cols
        out(1, c) = fieldOrder(c)
    Next
    
    Dim idx As Object
    Set idx = CreateObject("Scripting.Dictionary")
    idx.CompareMode = 1
    
    Dim sc As Long
    For sc = 1 To UBound(src, 2)
        idx(LCase$(Trim$(CStr(src(1, sc))))) = sc
    Next
    
    Dim r As Long
    For r = 2 To rows
        For c = 1 To cols
            Dim name As String
            name = fieldOrder(c)
            Dim colSrc As Long
            colSrc = 0
            If idx.Exists(LCase$(Trim$(name))) Then
                colSrc = idx(LCase$(Trim$(name)))
            End If
            If colSrc > 0 Then
                out(r, c) = src(r, colSrc)
            Else
                out(r, c) = ""
            End If
        Next
    Next
    
    WriteBlock wsDst, out, "A1"
    FormatBlock wsDst, "A1"
End Sub
VB

この ExportMasterLayout は、「どの列を、どの順番で出したいか」を fieldOrder 配列で指定するだけで、
加工済みマスタから必要な列だけを並び替えて出力してくれます。

列名でマッピングしているので、列順が変わっても壊れません。
別システムが要求するフォーマット(「CustomerID, CustomerName, Zip, Address, Phone …」など)を fieldOrder に書くだけで対応できます。


例題の通し方:顧客マスタと商品マスタを一括加工して、外部システム用に出力

ここまでの部品を組み合わせて、「一括で流れを回す」例を示します。

一括実行の例

' ModMaster_RunExample.bas
Option Explicit

Public Sub Run_MasterProcessing()
    ' 顧客マスタ加工
    ProcessCustomerMaster "CustomerRaw", "Z1"
    
    ' 商品マスタ加工
    ProcessProductMaster "ProductRaw", "Z1"
    
    ' 顧客マスタのエクスポート(外部システム用レイアウト)
    Dim custFields(1 To 6) As String
    custFields(1) = "CustomerID"
    custFields(2) = "顧客名"
    custFields(3) = "郵便番号"
    custFields(4) = "住所"
    custFields(5) = "電話番号"
    custFields(6) = "HasEmail"
    
    ExportMasterLayout "CustomerRaw", "Customer_Export", custFields
    
    ' 商品マスタのエクスポート
    Dim prodFields(1 To 6) As String
    prodFields(1) = "ProductID"
    prodFields(2) = "商品名"
    prodFields(3) = "NormCategory"
    prodFields(4) = "標準価格"
    prodFields(5) = "PriceBand"
    prodFields(6) = "NormNameKey"
    
    ExportMasterLayout "ProductRaw", "Product_Export", prodFields
    
    MsgBox "マスタ加工一括ツールの処理が完了しました。", vbInformation
End Sub
VB

この例では、

CustomerRaw シートにある元データを Z1 から“加工済み顧客マスタ”として出力し、さらに Customer_Export に外部用レイアウトで出力。
ProductRaw シートも同様に Z1 から加工済みを作り、Product_Export へ外部用を出力しています。

現場では、

元データを毎回 CustomerRaw / ProductRaw に貼る
Run_MasterProcessing を実行する
Customer_Export / Product_Export を CSV などで保存して他システムに渡す

という運用にすれば、誰がやっても同じ品質のマスタが毎回出てきます。


落とし穴と対策(重要ポイントの深掘り)

正規化不足で名寄せキーが割れてしまう

「株式会社」「(株)」「(株)」などの法人格、「全角スペース」「半角スペース」「全角英数」が混じると、
NormKey を通さずに名寄せキーを作るとほぼ確実に割れます。

顧客名・住所・電話・メール・商品名など「キーにしたい列」は必ず NormText / NormKey を通す、というルールを徹底するのが大事です。

名寄せキーの設計が甘いと誤マージされる

顧客名だけ、商品名だけで名寄せすると、「同姓同名」「似た商品名」が間違って一つにまとめられます。
顧客なら「顧客名+住所+電話」
商品なら「商品名+カテゴリ」
など、複数の情報を組み合わせてキーを設計します。

不安な場合は、“名寄せ候補一覧”を別出力して目視確認するステップを差し込んでも良いです。

既存コードと新採番が混ざってカオスになる

商品マスタの例では「既存コードがあればそれを優先、なければ採番」という方針を取っています。
ここを曖昧にすると、「同じ商品なのにコードが2種類」などが起こります。

方針は必ず明文化して、コードが無い場合だけ採番する、既存コードは尊重する、と決めてしまうのが安全です。

列名変更でエクスポートが壊れる

ExportMasterLayout は列名でマッピングしています。
元シートのヘッダ名と fieldOrder の指定が食い違うと“空列”で出力されます。

運用では、「ヘッダ名を仕様書に固定」しておき、変更する時はコードとセットで直す、という形にすると壊れにくくなります。

セル逐次処理で遅い

ループの中で Cells(r, c).Value などを直接読む/書くと、大きなマスタでは一気に遅くなります。
ここでは必ず「ReadRegion → 配列処理 → WriteBlock」でまとめて動かしています。

この形にしておけば、10万件規模のマスタでも現実的な時間で処理できます。


まとめ:マスタ加工は「正規化→名寄せ→項目追加→レイアウト出力」を型にしてしまう

マスタは一度この“型”を作ってしまえば、あとはルールを少し入れ替えるだけで何種類でも対応できます。

顧客マスタなら、法人/個人フラグ、メール可否、業種フラグ。
商品マスタなら、カテゴリ統一、価格帯フラグ、在庫有無フラグ。

こうした“加工”を全部 VBA に閉じ込めて、毎回同じ形を出せるようにしておくと、
後ろにぶら下がる発注・売上・分析のすべてが安定します。

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