【VBA】マスタ参照の存在チェックをDictionaryに置き換える

VBAのDictionaryでマスタ参照の存在チェックを書くコード例（If d.Exists(code) Then）を示したアイキャッチ VBA

店舗コードや銀行コード、支店コードを、マスタの表を見て別の値に変換する。見つからないコードは、エラーとして記録する。VBAでは、よく出てくる処理です。

私は、この処理をマスタの先頭から順に見ていく線形探索で書いていました。Foundフラグを立て、最後までフラグが立たなければエラー記録に回す形です。この形を定型にしておくと、店舗・銀行・支店のように複数の箇所で同じ書き方になり、見落としが減ります。

この記事では、同じ処理をDictionaryのExistsで書き換える方法を、線形探索版と並べて紹介します。書き換えたときに結果が変わる点（キーの型、大文字小文字、スペース、空のコードなど）は、実機で確かめた結果を載せます。

件数が増えたときの速度差は、【VBA】線形探索とDictionaryの速度差を実測比較で測っています。この記事では速度ではなく、書き方に絞ります。

こんな方に向けた記事です

  • マスタ照合を、ForループとFoundフラグで書いている
  • Dictionaryは使ったことがあるが、存在チェックの書き方に自信がない
  • 書き換えて結果が変わらないか、先に知っておきたい

線形探索版：Foundフラグで探す

まず、元の形です。マスタの1列目がコード、2列目が変換後の値の2次元配列とします。

Private errList As Collection

Private Sub RecordError(ByVal code As String)
    errList.Add code
End Sub

Function ConvertLinear(ByVal code As String, master As Variant) As String
    Dim i As Long
    Dim found As Boolean
    For i = LBound(master, 1) To UBound(master, 1)
        If master(i, 1) = code Then
            ConvertLinear = master(i, 2)
            found = True
            Exit For
        End If
    Next i
    If Not found Then RecordError code
End Function

コードを1件変換するたびに、マスタの先頭から比べていきます。一致したら値を返して抜け、最後までフラグが立たなければエラーを記録します。

Dictionaryで存在チェックを書く

マスタを先に1回だけDictionaryに積み、探すときはExistsで存在を確かめます。

Function BuildMasterDict(master As Variant) As Object
    Dim d As Object
    Dim i As Long
    Set d = CreateObject("Scripting.Dictionary")
    For i = LBound(master, 1) To UBound(master, 1)
        d.Add CStr(master(i, 1)), master(i, 2)
    Next i
    Set BuildMasterDict = d
End Function

Function ConvertByDict(ByVal code As String, d As Object) As String
    If d.Exists(code) Then
        ConvertByDict = d(code)
    Else
        RecordError code
    End If
End Function

呼び出す側は、次のようになります。

Sub DemoMasterCheck()
    Dim master As Variant
    Dim tmp(1 To 3, 1 To 2) As Variant
    Dim d As Object
    Dim codes As Variant
    Dim i As Long
    Dim x As Variant

    tmp(1, 1) = "A001": tmp(1, 2) = "Store-A"
    tmp(2, 1) = "A002": tmp(2, 2) = "Store-B"
    tmp(3, 1) = "007":  tmp(3, 2) = "Store-C"
    master = tmp

    Set d = BuildMasterDict(master)
    Set errList = New Collection

    codes = Array("A001", "007", "A999", "a002")
    For i = 0 To UBound(codes)
        Debug.Print codes(i) & " -> " & ConvertByDict(CStr(codes(i)), d)
    Next i

    Debug.Print "not found: " & errList.Count
    For Each x In errList
        Debug.Print "  " & x
    Next x
End Sub

実行すると、イミディエイトウィンドウには次のように出ます。

イミディエイトウィンドウの出力。A001とコード007は変換され、A999とa002は見つからずエラー記録に入った
再現用の最小コードの実行結果

見つからないA999と、大文字小文字が違うa002が、エラー記録に入りました。変換結果は空文字で返ります。

解説：何が置き換わったのか

ループとFoundフラグが消え、存在チェックはd.Exists(code)の1行になりました。見つかったときの値は、同じキーでd(code)と書けば取り出せます。

マスタの登録は、変換を始める前に1回だけ行います。登録時にキーをCStrで文字列にそろえているのは、次の章で説明するキーの型の違いを避けるためです。

Dictionaryの基本操作は、【VBA】個数を数える3つの方法とその速度比較でも使っています。Existsの仕様は、Microsoft LearnのExistsメソッドに載っています。

置き換えで結果が変わる点を実機で確かめた

Excel 16.0（64bit）、日本語版Windows（コードページ932）で確認しました。別のPCやMac版では確かめていません。

まず、線形探索版とDictionary版が同じ結果になるかを見ました。マスタ4件に対して、見つかるコード3件（A001・B100・007）と、見つからないコード2件（A999・XYZ）を渡すと、どちらも同じ値を返し、同じように見つかりませんでした。空のコードとa001を混ぜた6件でも、エラー一覧はA999・空文字・a001の3件で、両方とも同じでした。

そのうえで、書き換えるときに気をつけたい点を6つ確かめました。

1. 未登録のコードをd(code)で読むと、キーが増える

4件を登録したDictionaryで、未登録の"ZZZ"をd("ZZZ")と読みました。戻り値はEmptyでしたが、件数は4から5に増え、Exists("ZZZ")もTrueになりました。

存在の確認はExistsで行い、値を読むのは見つかったあとにします。

2. コードの型が違うと、別のキーになる

文字列の"007"・数値の7・文字列の"7"は、すべて別のキーでした。"007"だけを登録したとき、Exists("007")だけがTrueで、Exists(7)とExists("7")はFalseです。数値のキー1は、Integer・Long・Double・Singleのどれで渡しても同じキーとして見つかり、文字列の"1"では見つかりませんでした。

線形探索の=も、型の組み合わせで結果が変わりました。

左辺（マスタ側）右辺（検索側）結果
Variant（文字列"001"）Variant（整数1）一致しない
Variant（文字列"1"）Variant（整数1）一致しない
Variant（文字列"007"）Variant（Double 7）一致しない
Variant（整数1）String型の"001"一致しない
Variant（Double 7）String型の"7"一致する
Variant（Double 7）String型の"007"一致しない

マスタの数値型のコード（Double）に、String型の"7"を渡すと見つかり、"007"は見つかりませんでした。マスタを登録するときにCStrで文字列にそろえ、検索側も文字列で渡すと、型の違いによるずれを避けられます。先頭に0が付くコードは、数値で持つと0が失われるため、文字列で持ちます。

3. 大文字小文字は区別される。CompareModeは登録の前に指定する

CompareModeの既定値は0（バイナリ）で、"a001"は"A001"として見つかりません。線形探索の=も同じでした（モジュール先頭にOption Compare Textを書いていない場合）。

CompareMode = 1（vbTextCompare）にすると、"a001"で見つかり、値も取り出せます。全角のＡ００１も、テキストモードでは見つかり、バイナリでは見つかりませんでした。

キーを1件登録したあとでCompareMode = 1を設定すると、実行時エラー5になり、CompareModeは0のままでした。指定は、キーを登録する前に行います。

4. 末尾のスペースは見つからない。Trimで除ける

"A001 "（末尾に半角スペース）は、線形探索でもDictionaryでも見つかりませんでした。Trimで除くと見つかります。

全角スペース（U+3000）をA001の後ろに付けた文字列にTrimをかけると、今回の環境では長さが4になり、全角スペースも除かれました。Replaceで除いても見つかります。

シートのVLOOKUPでも、末尾のスペースで#N/Aになります。関数側の確認は、【Excel関数】#N/A・#VALUE!・#REF!が出たら最初に確認にまとめています。

5. 空のコードは、マスタに空行があると「見つかる」

空のDictionaryでは、Exists("")はFalseです。空文字をキーとして登録すると、Trueになります。線形探索でも、マスタに空行があれば、空のコードは見つかりました。

マスタの範囲に空行が2行あると、BuildMasterDictの2つ目の空キーで実行時エラー457になりました。空行のないマスタに空のコードを渡すと、見つからず、空文字がエラー記録に入ります。

6. 重複キーは、Addではエラー、代入では上書きになる

登録済みの"A001"にd.Add "A001", "Dup"を実行すると、実行時エラー457（メッセージは「このキーは既にこのコレクションの要素に割り当てられています。」）になりました。件数は4のまま、値もStore-Aのままです。

d("A001") = "Over"と代入した場合は、エラーにならず、件数は4のまま、値がOverに変わりました。

マスタの重複を検出したいときはAdd、後の値で上書きしてよいときは代入を使います。

応用例：マスタが複数あるとき

店舗・銀行・支店のようにマスタが複数あるときは、マスタごとにDictionaryを作り、同じConvertByDictに渡します。

Set dShop = BuildMasterDict(shopMaster)
Set dBank = BuildMasterDict(bankMaster)
shopName = ConvertByDict(shopCode, dShop)
bankName = ConvertByDict(bankCode, dBank)

どのマスタで見つからなかったかを残したいときは、RecordErrorにマスタ名を渡す引数を足します。

まとめ

コメント

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