[VBA]DictionaryのExistsメソッドを正しく知る

VBAでDicitonaryを使用しているとExistsメソッドの存在は避けて通れません。

なぜならばDictionaryにデータを追加する場合に、事前に重複するキーがすでに格納されていないか知る必要があるからです。

Errorコードから存在を確認することは出来ますが、わざわざオブジェクトが提供してくれている機能を使用しないのはスマートではないですよね。

今回はせっかくなのでDictionaryのExistsメソッドの使い方やExistsメソッドに関連する話題を取り上げてみたいと思います。

普段からDicitonaryを当たり前のように使用されている方も、そうでない方も少しの時間、お付き合い頂けたら幸いです。

Existsメソッドとは
Existsメソッドの基本的な使い方
1. 処理の補足
Existsメソッドで重複しないリストを作る
1. 処理の補足
Existsメソッドで全半角、大文字・小文字を区別しない方法
1. 格納前にキーを加工する方法
  1. 処理の補足
2. Dictionaryのキーの比較モードを変更する方法
  1. 処理の補足
Existsメソッドで部分一致させたい
1. 番外編：Dictionaryを部分一致させる方法
  1. 処理の補足
Existsメソッドのまとめ

Existsメソッドとは

DictionaryのExistsメソッドとは、Dictionaryに格納されたペアのキーに一致する値が存在するか否かをBoolean(True/False)で返すメソッドです。

Dictionaryそのものは重複したキーの格納を仕様上認めていないため、Addメソッドでペアを格納する場合にはエラーが発生してしまうので、キーが重複する心配はありません。

しかしAddメソッドで追加する時以外ではキーの存在を確認する場合、どうすればいいのか。

都度Addメソッドでエラーを確認するような非効率な方法で存在を確認するのは、泥臭くてスマートではないし、ちょっと格好悪いですよね。

Dictionaryはキー検索のメソッドが用意されており、それがExistsメソッドというわけです。

Dictionaryそのものの説明は以下で詳しく扱っていますので、ご参考までに。

[VBA]Dictionary（連想配列）の使い方とテクニック

Dictionary（連想配列）を使ったテクニックを公開しています。プロパティやメソッドの説明、基本から応用まで多数サンプルを用意してDictionary（連想配列）を徹底追求。具体的な使い方にお悩みの方は是非参考にして頂けると幸いです。

Existsメソッドの基本的な使い方

Option Explicit

Sub Dictionary_Exists_Sample()

    Dim objDic As New Dictionary

    objDic.Add "北海道", "AAA000"
    objDic.Add "東北", "BBB000"
    objDic.Add "中央", "CCC000"
    objDic.Add "東海", "DDD000"
    objDic.Add "北陸", "EEE000"
    objDic.Add "関西", "FFF000"
    objDic.Add "中国", "GGG000"
    objDic.Add "四国", "HHH000"
    objDic.Add "九州", "III000"
    
    '「関西」という値がキーに設定されているか否かを確認する
    If objDic.Exists("関西") Then
        Debug.Print "関西は格納されています"
    Else
        Debug.Print "関西は格納されていません"
    End If
    
    objDic.RemoveAll
    
    Set objDic = Nothing
    
End Sub

処理の補足

上のサンプルではあらかじめDictionaryに複数のペアを追加しており、その後に「関西」が格納されているかキー検索としてExistsメソッドで結果を確認している処理になります。

キーが存在していればIfの分岐でTrue/Falseを返し、いずれかの結果をデバッグ出力します。

見ての通り、「関西」はあらかじめ追加したペアに該当するキーのため、結果は以下の通りです。

大変便利なメソッドです。

上のサンプルでは少ないデータを扱ったサンプルになるので、目視でも容易に結果が得られる内容ですが、データの規模が100件や1000件を超えると目視ではとても厳しい状況になるでしょう。

Dictionaryではデータの規模が100件だろうと1000件だろうと、Existsメソッドで一発解決です。

速度の定評のある配列の繰り返し処理で同じ処理を実現しようとする場合、全件総なめでキーの値を確認していくことになります。

確認するキーが1件であればまだいいですが、確認するリスト側も1000件くらいあった場合、さすがの配列も繰り返しの嵐に揉まれ、「本当にこの手段しかないのか？」と別のやり方を模索したくなることでしょう。

そんな中でこのDictionaryのExistsメソッドは無駄なループは必要ありません。

Existsメソッドで合致するキーが存在するか確認すればいいだけです。

Dictionaryは使い方を誤らなければ、とても強力なオブジェクトですが、その理由の一つにExistsメソッドがあることは揺るがないでしょう。

Existsメソッドで重複しないリストを作る

これはあくまでDictionaryで重複しないリストを作るだけなのですが、重複をしないリストを作る中でのExistsメソッドの使われ方などをご紹介できればと挙げてみました。

以下のような表があったとしよう。

単純に品目別の合算値を必要とする場合、当然として重複するリストでは困るわけで重複しないユニークな品目リストである必要となります。

さらに合算値の計算など一緒に組み込むロジックをDictionaryとExistsメソッドを使って表現してみようと思います。

Option Explicit

Sub Dictionary_Create_UniqueList_Sample()

    Dim arrCell As Variant
    Dim objDic As New Dictionary
    Dim i As Integer
    Dim v As Variant
    
    arrCell = ThisWorkbook.ActiveSheet.UsedRange.Value
    
    For i = LBound(arrCell, 1) To UBound(arrCell, 1)
        If Not objDic.Exists(arrCell(i, 1)) Then
            objDic.Add arrCell(i, 1), arrCell(i, 2)
        ElseIf IsNumeric(arrCell(i, 2)) Then
            objDic.Item(arrCell(i, 1)) = objDic.Item(arrCell(i, 1)) + arrCell(i, 2)
        End If
    Next
    
    For Each v In objDic.Keys
        Debug.Print v & vbTab & "|" & vbTab & objDic.Item(v)
        Debug.Print "--------------------"
    Next
    
    objDic.RemoveAll
    
    Set objDic = Nothing
    
End Sub

処理の補足

上のサンプルはExcel上のデータを使用しているため、Excel上でVBAを実行することを想定した処理となっています。

アクティブシートの使用済み領域の値を配列に格納
DictionaryにA列の値をキーに、B列の値をアイテムとしたペアを追加
Existsメソッドでキー検索→すでに格納済みの場合、B列が数字であればアイテムに合算
ループ処理でDictionaryの内容をデバッグ出力

データの仕様によってはDictionaryへ格納、合算していくロジックにもっと複雑な条件が必要とされる場合もあると思いますが、今回はサンプルということでシンプルな処理になっています。

結果は以下のとおりです。

※AccessやExcel以外のOffice上から実行される場合はExcelへアプローチするための別途ロジックを追加する必要があります。

Existsメソッドで全半角、大文字・小文字を区別しない方法

Dictionaryにペアを追加する際、重複するキーを追加することは出来ませんが、キーを厳密に合致させたくない場合が状況によって生じるケースがあります。

Existsメソッドで厳密に合致させたくない場合とは以下のような状況のこと

全角・半角の区別を厳密にしたくない
大文字・小文字の区別を厳密にしたくない

重複しないリストは作りたいが、キーとなる値の精度が悪いケースに直面することがあるわけです。

例えば以下のようなデータ

これは職業としてVBAを使っているとよくある話ですが、システムから出力したデータであれば、自由入力の値でなければ統一感があってトラブルは少ないのですが、手入力によるEXCELで管理されたデータを処理に使用する場合、値にバラツキが生じることがよくあります。

データ管理に関わっている担当者のスキルにもよりますが、Excel使用者は幅広いスキル層で使用されているため、キーに厳密性を求めた場合、Dictionaryへの格納に弊害が生じてしまうわけです。

普通に格納していくと以下のような結果になります。

このような結果を求めていた場合には問題はないですが、重複しないリストを作成したいのに、文字のばらつきでユニークにならない問題はなかなか悩みますよね。

解決手段として、格納前にキーを加工する場合か、またはDictionaryのキーの比較モードを変更させることで対応することができるようになります。

格納前にキーを加工する方法

Dictionaryのキーとなる値の傾向を分析して、キーを統一できるように必要に応じた加工を実施後にDictionary上のキー検索、ペア格納を実施していく方法となります。

上のデータを使用する場合は、全角・半角・大文字・小文字が入り乱れた内容になっておりますので、以下のような処理で取り込みます。

Option Explicit

Sub Dictionary_Create_UniqueList_Sample()

    Dim arrCell As Variant
    Dim objDic As New Dictionary
    Dim strKey As String
    Dim i As Integer
    Dim v As Variant
    
    arrCell = ThisWorkbook.ActiveSheet.UsedRange.Value
    
    For i = LBound(arrCell, 1) To UBound(arrCell, 1)
        strKey = arrCell(i, 1)
        strKey = StrConv(strKey, vbUpperCase)
        strKey = StrConv(strKey, vbWide)
        If Not objDic.Exists(strKey) Then
            objDic.Add strKey, arrCell(i, 2)
        ElseIf IsNumeric(arrCell(i, 2)) Then
            objDic.Item(strKey) = objDic.Item(strKey) + arrCell(i, 2)
        End If
    Next
    
    For Each v In objDic.Keys
        Debug.Print v & vbTab & "|" & vbTab & objDic.Item(v)
        Debug.Print "--------------------"
    Next
    
    objDic.RemoveAll
    
    Set objDic = Nothing
    
End Sub

処理の補足

基本的な処理のはじめの部分は上のサンプルと同じですが、途中で少し違います。

アクティブシートの使用済み領域の値を配列に格納
変数strKeyにA列の値を格納
変数strKeyの値を全角に加工
変数strKeyの値を大文字に加工
Dictionaryに変数strKeyの値をキーに、B列の値をアイテムとしたペアを追加
Existsメソッドで変数strKeyの値をキー検索→すでに格納済みの場合、B列が数字であればアイテムに合算
ループ処理でDictionaryの内容をデバッグ出力

結果は以下のとおりです。

Dictionaryのキーの比較モードを変更する方法

Dictionaryのキーの比較モードを変更するとはそもそもどういうことか？という点ですが、Dictionaryは仕様上、キーの重複は認めていません。

ではいったいDictionary自身はどうやってキーの重複を判定しているのか？という部分が実は着眼点だったりするわけです。

上のように変数に値を逃がして加工して、加工後の値をキーとするやり方もいいのですが、DictionaryのプロパティにはCompareMode（比較モード）という項目があり、キー重複判定のタイプを設定することができます。

プロパティ

説明

CompareMode

キーの比較モード：大文字と小文字、全半角を区別したい時に指定

定数	値	説明
vbBinaryCompare	0	厳密に比較したい
vbTextCompare	1	あいまいに比較したい

このCompareMode（比較モード）はデフォルトではvbBinaryCompare（バイナリ比較）が設定されていて、厳密にキーの比較判定が実施されていますが、vbTextCompare（テキスト比較）に変更してやることで厳密性を少しあいまいにすることができるようになります。

Option Explicit

Sub Dictionary_Create_UniqueList_Sample()

    Dim arrCell As Variant
    Dim objDic As New Dictionary
    Dim i As Integer
    Dim v As Variant
    
    arrCell = ThisWorkbook.ActiveSheet.UsedRange.Value
    
    objDic.CompareMode = TextCompare
    
    For i = LBound(arrCell, 1) To UBound(arrCell, 1)
        If Not objDic.Exists(arrCell(i, 1)) Then
            objDic.Add arrCell(i, 1), arrCell(i, 2)
        ElseIf IsNumeric(arrCell(i, 2)) Then
            objDic.Item(arrCell(i, 1)) = objDic.Item(arrCell(i, 1)) + arrCell(i, 2)
        End If
    Next
    
    For Each v In objDic.Keys
        Debug.Print v & vbTab & "|" & vbTab & objDic.Item(v)
        Debug.Print "--------------------"
    Next
    
    objDic.RemoveAll
    
    Set objDic = Nothing
    
End Sub

処理の補足

こちらだと１行追加のみで対処可能になります。

アクティブシートの使用済み領域の値を配列に格納
Dictionaryの比較モードをテキスト比較「1」に変更
DictionaryにA列の値をキーに、B列の値をアイテムとしたペアを追加
Existsメソッドでキー検索→すでに格納済みの場合、B列が数字であればアイテムに合算
ループ処理でDictionaryの内容をデバッグ出力

とてもシンプルなメンテナンスで対応できる点がいいと思います。

結果は以下のとおりです。

キーとして採用される値は最初に格納された値となるため、大文字で統一したい、半角で統一したいなど条件がある場合ですと、格納前に値を加工が必要となります。

Existsメソッドで部分一致させたい

DictionaryのExistsメソッドで部分一致をさせることができるのか？ということですが、基本的には出来ません。

比較モードで完全一致にややあいまいさを調整するくらいであればプロパティ上で用意がありますが、部分一致をExistsメソッドで実現することはできません。

そもそもワイルドカードの扱いも受け付けていないので、Like演算子のような使い方は出来ないです。

ただそれだけだと面白くない。

本当にやりようはないのか？という話になればそんなこともないです。

結局のところ、「実現する方法はあるけど少し作りこむ必要があるよ」ということです。

単純にExistsメソッドを使っただけだと実現できないけど、別の方法で部分一致をあぶり出すことはできます。

番外編：Dictionaryを部分一致させる方法

例えばこのようなデータがあったとします。

商品名で部分一致できそうな文字をちりばめてみました。

Dictionaryに格納した後にExistsメソッドのように部分一致が成立していればTrue/Falseを返す処理にするのか、部分一致したペアのみを格納したDictionaryとして後続の処理に使っていきたいのか、でそれぞれやり方が変わってきます。

部分一致させたいくらいだから、基本的にはExcelのフィルタ機能のように「部分一致で絞られたDictionaryを使って何かしたい」と考えるのが自然ですかね。それでいきましょう！

Option Explicit

Sub Dictionary_GetKeyPatternDic_Sample()

    Dim arrCell As Variant
    Dim objDic As New Dictionary
    Dim objPatternDic As Dictionary
    Dim i As Integer
    Dim v As Variant
    
    arrCell = ThisWorkbook.ActiveSheet.UsedRange.Value
    
    For i = LBound(arrCell, 1) To UBound(arrCell, 1)
        objDic.Add arrCell(i, 1), arrCell(i, 2)
    Next
    
    Debug.Print "========================="
    Debug.Print "取り込んだペア一覧"
    Debug.Print "=========================" & vbCrLf
    
    For Each v In objDic.Keys
        Debug.Print v & vbTab & "|" & vbTab & objDic.Item(v)
        Debug.Print "--------------------"
    Next
    
    Set objPatternDic = GetKeyPatternDictionary(objDic, "*傘")
    
    Debug.Print "========================="
    Debug.Print "「*傘」で絞ったペア一覧"
    Debug.Print "=========================" & vbCrLf
    
    For Each v In objPatternDic.Keys
        Debug.Print v & vbTab & "|" & vbTab & objPatternDic.Item(v)
        Debug.Print "--------------------"
    Next
    
    Set objPatternDic = GetKeyPatternDictionary(objDic, "*い*")
    
    Debug.Print "========================="
    Debug.Print "「*い*」で絞ったペア一覧"
    Debug.Print "=========================" & vbCrLf
    
    For Each v In objPatternDic.Keys
        Debug.Print v & vbTab & "|" & vbTab & objPatternDic.Item(v)
        Debug.Print "--------------------"
    Next
    
    objDic.RemoveAll
    
    Set objDic = Nothing
    
End Sub

Function GetKeyPatternDictionary(ByVal objDic As Dictionary, ByVal strPattern As String) As Dictionary
    
    Dim objDic_KeyPattern As New Dictionary
    Dim v As Variant
    
    For Each v In objDic.Keys
        If v Like strPattern Then objDic_KeyPattern.Add v, objDic.Item(v)
    Next
    
    Set GetKeyPatternDictionary = objDic_KeyPattern
    
End Function