VBA

【VBA】連想配列を扱う『Dictionary』＋『自作クラス』

 

一般的な配列は、添え字に数値を使用します。そうではなく、文字列の要素を文字の添え字で操作できるような配列を 連想配列と呼びます。例えば商品名と価格のような関係です。

連想配列を使用する場合、Dictionaryオブジェクトを使用する方法とCollectionオブジェクトを使用する方法とがあります。ここではDictionaryオブジェクトを使用する方法を紹介します。

また、Dictionaryオブジェクトは「Microsoft Scripting Runtime」が必須でMACのEXCELでは使用出来なかったり環境によって動作が変わる恐れがあるので、この記事では連想配列を管理操作するクラスを自作する方法も紹介します。

Dictionaryオブジェクトを使用する方法

Dictionaryオブジェクトにて連想配列を使用する場合、以下の通り宣言します。

Dim 連想配列名 As Object
Set 連想配列名 = CreateObject(“Scripting.Dictionary”)

Dictionaryオブジェクトには以下のメソッドとプロパティが用意されています。

メソッド説明
AddDictionary オブジェクトに新しいキーとアイテムを追加します
ExistsDictionary オブジェクト内に指定したキーが存在する場合True、存在しない場合Falseを返します
ItemsDictionary オブジェクト内のすべてのアイテムの配列を返します
KeysDictionary オブジェクト内のすべてのキーの配列を返します
RemoveDictionary オブジェクトから、指定したキーとアイテムを削除します
RemoveAllDictionary オブジェクト内のすべてのキーとアイテムを削除します
プロパティ説明
CompareModeDictionary オブジェクト内でキーを比較するために大文字と小文字を区別するか指定します
CountDictionary オブジェクト内のキー、アイテムの数を返します
ItemDictionary オブジェクト内のアイテムの値を設定するか返します

連想配列に値を追加する場合はAddメソッドを使用してキーとアイテムを追加します。

Dictionary オブジェクトの初期化

Dim myDict As Object
Set myDict = CreateObject("Scripting.Dictionary")

キーと値の追加『Dictionary』

myDict.Add "Name", "John"
myDict.Add "Age", 30
myDict.Add "Country", "USA"

キーを使用した値の取得『Dictionary』

Dim nameValue As String
nameValue = myDict("Name")

キーの存在確認『Dictionary』

If myDict.Exists("Age") Then
    ' キーが存在する場合の処理
End If

キーと値の削除『Dictionary』

myDict.Remove "Country"

全てのキー・値を取得『Dictionary』

Dim key As Variant
For Each key In myDict.Keys
    Debug.Print key & ": " & myDict(key)
Next key

サンプル『Dictionary』

Sub DictionaryExample()
    Dim myDict As Object
    Set myDict = CreateObject("Scripting.Dictionary")
    
    ' キーと値の追加
    myDict.Add "Name", "John"
    myDict.Add "Age", 30
    myDict.Add "Country", "USA"
    
    ' キーを使用した値の取得
    Dim nameValue As String
    nameValue = myDict("Name")
    Debug.Print "Name: " & nameValue
    
    ' キーの存在確認
    If myDict.Exists("Age") Then
        Debug.Print "Age exists."
    End If
    
    ' キーと値の削除
    myDict.Remove "Country"
    
    ' 全てのキー・値を取得
    Dim key As Variant
    For Each key In myDict.Keys
        Debug.Print key & ": " & myDict(key)
    Next key
End Sub

Dictionary オブジェクトは、データを柔軟に管理する事ができ、VBAでデータ処理を行う際に頻繁に使用されます。

連想配列操作クラスの自作

記事の初めにも書きましたが、DictionaryオブジェクトはMACでは使用出来なかったり、少し機能が不足している所もあります。そこで、クラスモジュールを利用して「拡張版Dictionaryクラス」を作成する方法を紹介したいと思います。非常に便利なクラスなので、是非利用してみて下さい。

連想配列管理クラス基本実装

クラスモジュールを挿入して下記コードをコピペして下さい。

' CustomDictionary クラスの定義
Class CustomDictionary
    Private data As Collection
    
    Private Sub Class_Initialize()
        Set data = New Collection
    End Sub
    
    ' キーと値の追加
    Public Sub Add(key As Variant, value As Variant)
        On Error Resume Next
        data.Add value, CStr(key)
        On Error GoTo 0
    End Sub
    
    ' キーを使用した値の取得
    Public Function Item(key As Variant) As Variant
        On Error Resume Next
        Item = data(CStr(key))
        On Error GoTo 0
    End Function
    
    ' キーの存在確認
    Public Function Exists(key As Variant) As Boolean
        On Error Resume Next
        Exists = Not IsEmpty(data(CStr(key)))
        On Error GoTo 0
    End Function
    
    ' キーと値の削除
    Public Sub Remove(key As Variant)
        On Error Resume Next
        data.Remove CStr(key)
        On Error GoTo 0
    End Sub
    
    ' 全てのキーの取得
    Public Function Keys() As Collection
        Set Keys = New Collection
        Dim item As Variant
        For Each item In data
            Keys.Add item
        Next item
    End Function
    
    ' 全ての値の取得
    Public Function Values() As Collection
        Set Values = New Collection
        Dim item As Variant
        For Each item In data
            Values.Add data(item)
        Next item
    End Function
End Class

このクラスを使用する例を以下に示します。

Sub CustomDictionaryExample()
    Dim myDict As New CustomDictionary
    
    ' キーと値の追加
    myDict.Add "Name", "John"
    myDict.Add "Age", 30
    myDict.Add "Country", "USA"
    
    ' キーを使用した値の取得
    Dim nameValue As Variant
    nameValue = myDict.Item("Name")
    Debug.Print "Name: " & nameValue
    
    ' キーの存在確認
    If myDict.Exists("Age") Then
        Debug.Print "Age exists."
    End If
    
    ' キーと値の削除
    myDict.Remove "Country"
    
    ' 全てのキーの取得
    Dim key As Variant
    For Each key In myDict.Keys
        Debug.Print key & ": " & myDict.Item(key)
    Next key
End Sub

このサンプルコードは、CustomDictionary クラスを使って基本的な辞書操作を行います。
基本的にDictionaryオブジェクトと使い方を合わせて実装しているので、迷わず使用可能だと思います。

CustomDictionary クラスの拡張

現在実装した、CustomDictionaryクラスは標準のDictionaryオブジェクトに比べて貧弱です。そこで、辞書のクリア、要素の数の取得、特定の値が含まれているかどうかの確認などを実装してDictionaryオブジェクトと同レベルまでクラスを引き上げたいと思います。

' CustomDictionary クラスの定義
Class CustomDictionary
    Private data As Collection
    
    Private Sub Class_Initialize()
        Set data = New Collection
    End Sub
    
    ' キーと値の追加
    Public Sub Add(key As Variant, value As Variant)
        On Error Resume Next
        data.Add value, CStr(key)
        On Error GoTo 0
    End Sub
    
    ' キーを使用した値の取得
    Public Function Item(key As Variant) As Variant
        On Error Resume Next
        Item = data(CStr(key))
        On Error GoTo 0
    End Function
    
    ' キーの存在確認
    Public Function Exists(key As Variant) As Boolean
        On Error Resume Next
        Exists = Not IsEmpty(data(CStr(key)))
        On Error GoTo 0
    End Function
    
    ' キーと値の削除
    Public Sub Remove(key As Variant)
        On Error Resume Next
        data.Remove CStr(key)
        On Error GoTo 0
    End Sub
    
    ' 全てのキーの取得
    Public Function Keys() As Collection
        Set Keys = New Collection
        Dim item As Variant
        For Each item In data
            Keys.Add item
        Next item
    End Function
    
    ' 全ての値の取得
    Public Function Values() As Collection
        Set Values = New Collection
        Dim item As Variant
        For Each item In data
            Values.Add data(item)
        Next item
    End Function
    
    ' 辞書のクリア
    Public Sub Clear()
        Set data = New Collection
    End Sub
    
    ' 要素の数を取得
    Public Function Count() As Long
        Count = data.Count
    End Function
    
    ' 特定の値が含まれているか確認
    Public Function ContainsValue(value As Variant) As Boolean
        Dim item As Variant
        For Each item In data
            If data(item) = value Then
                ContainsValue = True
                Exit Function
            End If
        Next item
        ContainsValue = False
    End Function
End Class

このクラスを使用する例を以下に示します。

Sub CustomDictionaryExtendedExample()
    Dim myDict As New CustomDictionary
    
    ' キーと値の追加
    myDict.Add "Name", "John"
    myDict.Add "Age", 30
    myDict.Add "Country", "USA"
    
    ' キーと値の表示
    PrintDictionary myDict
    
    ' 辞書のクリア
    myDict.Clear
    
    ' キーと値の追加（クリア後）
    myDict.Add "City", "New York"
    myDict.Add "Population", 8500000
    
    ' 新しいキーと値の表示
    PrintDictionary myDict
    
    ' 要素の数の表示
    Debug.Print "Number of elements: " & myDict.Count
    
    ' 特定の値が含まれているか確認
    Debug.Print "Contains 'New York': " & myDict.ContainsValue("New York")
    Debug.Print "Contains 'Tokyo': " & myDict.ContainsValue("Tokyo")
End Sub

Sub PrintDictionary(dict As CustomDictionary)
    Dim key As Variant
    For Each key In dict.Keys
        Debug.Print key & ": " & dict.Item(key)
    Next key
End Sub

クラスに新しいメソッド Clear、Count、および ContainsValue を追加しました。これらのメソッドは、辞書のクリア、要素の数の取得、特定の値が含まれているかどうかの確認を行います。これで、Dictionaryオブジェクトと同レベルの処理が可能なクラスが出来上がりました。

Dictionaryオブジェクトを超える

更に機能を追加して便利なクラスにしてみましょう。
map、filter、および sort 関数を追加してみます。

' CustomDictionary クラスの定義
Class CustomDictionary
    Private data As Collection
    
    Private Sub Class_Initialize()
        Set data = New Collection
    End Sub
    
    ' 他のメソッドは省略
    
    ' map 関数の実装
    Public Function Map(func As Variant) As CustomDictionary
        Dim result As New CustomDictionary
        Dim key As Variant
        For Each key In data
            result.Add key, func(data(key))
        Next key
        Set Map = result
    End Function
    
    ' filter 関数の実装
    Public Function Filter(func As Variant) As CustomDictionary
        Dim result As New CustomDictionary
        Dim key As Variant
        For Each key In data
            If func(data(key)) Then
                result.Add key, data(key)
            End If
        Next key
        Set Filter = result
    End Function
    
    ' sort 関数の実装
    Public Sub Sort(Optional descending As Boolean = False)
        Dim keys As Collection
        Set keys = Me.Keys
        
        ' キーの取得
        Dim arrKeys() As Variant
        ReDim arrKeys(1 To keys.Count)
        Dim i As Integer
        For i = 1 To keys.Count
            arrKeys(i) = keys(i)
        Next i
        
        ' ソート
        If descending Then
            QuickSortDesc arrKeys, 1, keys.Count
        Else
            QuickSort arrKeys, 1, keys.Count
        End If
        
        ' ソート後のキーを使用して新しい辞書を構築
        Dim result As New CustomDictionary
        For i = 1 To UBound(arrKeys)
            result.Add arrKeys(i), data(arrKeys(i))
        Next i
        
        ' 元の辞書をクリアし、ソート後の辞書に置き換える
        Me.Clear
        Set data = result.data
    End Sub
    
    ' クイックソートのサポート関数（昇順）
    Private Sub QuickSort(arr() As Variant, low As Integer, high As Integer)
        Dim i As Integer
        Dim j As Integer
        Dim pivot As Variant
        Dim temp As Variant
        
        If low < high Then
            pivot = arr((low + high) \ 2)
            i = low
            j = high
            Do
                Do While arr(i) < pivot
                    i = i + 1
                Loop
                Do While pivot < arr(j)
                    j = j - 1
                Loop
                If i <= j Then
                    temp = arr(i)
                    arr(i) = arr(j)
                    arr(j) = temp
                    i = i + 1
                    j = j - 1
                End If
            Loop While i <= j
            QuickSort arr, low, j
            QuickSort arr, i, high
        End If
    End Sub
    
    ' クイックソートのサポート関数（降順）
    Private Sub QuickSortDesc(arr() As Variant, low As Integer, high As Integer)
        Dim i As Integer
        Dim j As Integer
        Dim pivot As Variant
        Dim temp As Variant
        
        If low < high Then
            pivot = arr((low + high) \ 2)
            i = low
            j = high
            Do
                Do While arr(i) > pivot
                    i = i + 1
                Loop
                Do While pivot > arr(j)
                    j = j - 1
                Loop
                If i <= j Then
                    temp = arr(i)
                    arr(i) = arr(j)
                    arr(j) = temp
                    i = i + 1
                    j = j - 1
                End If
            Loop While i <= j
            QuickSortDesc arr, low, j
            QuickSortDesc arr, i, high
        End If
    End Sub
End Class

この追加は、Map メソッドで各要素に関数を適用し、Filter メソッドで条件に基づいて要素を選択し、Sort メソッドで昇順または降順にソートする機能が CustomDictionary クラスに追加しました。

ここで使われている QuickSort および QuickSortDesc はクイックソートアルゴリズムを実装したサポート関数です。これを使ってキーをソートしています。

例えば以下のように CustomDictionary を使って map や filter、sort を行うことができます。

Sub TestCustomDictionary()
    ' CustomDictionary インスタンスの作成
    Dim myDict As New CustomDictionary
    
    ' データの追加
    myDict.Add "Alice", 30
    myDict.Add "Bob", 25
    myDict.Add "Charlie", 40
    
    ' データの表示
    myDict.PrintData
    
    ' 年齢を2倍にする map 関数
    Set myDict = myDict.Map(AddressOf DoubleAge)
    myDict.PrintData
    
    ' 30歳以上の要素を選択 filter 関数
    Set myDict = myDict.Filter(AddressOf Above30)
    myDict.PrintData
    
    ' 年齢でソート（降順） sort 関数
    myDict.Sort descending:=True
    myDict.PrintData
End Sub

' 年齢を2倍にする関数
Function DoubleAge(age As Variant) As Variant
    DoubleAge = age * 2
End Function

' 30歳以上の要素を選択する関数
Function Above30(age As Variant) As Boolean
    Above30 = age >= 30
End Function

この例では、TestCustomDictionary サブルーチンで CustomDictionary インスタンスを作成し、map 関数で年齢を2倍にし、filter 関数で30歳以上の要素を選択し、最後に sort 関数で降順にソートしています。各ステップでの変更が PrintData メソッドを用いて表示させています。

これらの関数を組み合わせることで、柔軟で拡張性のあるデータ処理が可能になりました。

2次元連想配列への対応

2次元の連想配列に対応するために、CustomDictionary クラスを拡張し、行と列の両方に対応するように変更します。

変更後の CustomDictionary クラスは以下の通りです。

' CustomDictionary クラスの定義
Public Class CustomDictionary
    Private data As Collection

    ' コンストラクタ
    Public Sub Initialize()
        Set data = New Collection
    End Sub

    ' Add メソッドの変更
    Public Sub Add(key1 As Variant, key2 As Variant, value As Variant)
        Dim innerDict As New Dictionary
        On Error Resume Next
        Set innerDict = data(key1)
        On Error GoTo 0

        If innerDict Is Nothing Then
            Set innerDict = New Dictionary
            data.Add innerDict, key1
        End If

        innerDict.Add key2, value
    End Sub

    ' Remove メソッドの追加
    Public Sub Remove(key1 As Variant, key2 As Variant)
        Dim innerDict As Dictionary
        On Error Resume Next
        Set innerDict = data(key1)
        On Error GoTo 0

        If Not innerDict Is Nothing Then
            innerDict.Remove key2
            If innerDict.Count = 0 Then
                data.Remove key1
            End If
        End If
    End Sub

    ' HasKey メソッドの追加
    Public Function HasKey(key1 As Variant, key2 As Variant) As Boolean
        Dim innerDict As Dictionary
        On Error Resume Next
        Set innerDict = data(key1)
        On Error GoTo 0

        If Not innerDict Is Nothing Then
            HasKey = innerDict.Exists(key2)
        Else
            HasKey = False
        End If
    End Function

    ' Keys メソッドの追加
    Public Function Keys() As Collection
        Dim result As New Collection
        Dim key1 As Variant
        For Each key1 In data
            result.Add key1
        Next key1
        Set Keys = result
    End Function

    ' Values メソッドの追加
    Public Function Values() As Collection
        Dim result As New Collection
        Dim key1 As Variant
        Dim innerDict As Dictionary
        For Each key1 In data
            Set innerDict = data(key1)
            result.Add innerDict.Items
        Next key1
        Set Values = result
    End Function

    ' Clear メソッドの追加
    Public Sub Clear()
        Set data = New Collection
    End Sub

    ' Item メソッドの追加
    Public Function Item(key1 As Variant, key2 As Variant) As Variant
        Dim innerDict As Dictionary
        On Error Resume Next
        Set innerDict = data(key1)
        On Error GoTo 0

        If Not innerDict Is Nothing Then
            Item = innerDict(key2)
        Else
            Item = Empty
        End If
    End Function

    ' PrintData メソッドの修正
    Public Sub PrintData()
        Dim key1 As Variant
        Dim key2 As Variant
        Dim value As Variant

        For Each key1 In data
            Set innerDict = data(key1)
            For Each key2 In innerDict.Keys
                value = innerDict(key2)
                Debug.Print key1 & ", " & key2 & ": " & value
            Next key2
        Next key1
    End Sub

    ' Map メソッドの追加
    Public Function Map(func As Variant) As Collection
        Dim result As New Collection
        Dim key1 As Variant
        Dim key2 As Variant
        Dim value As Variant

        For Each key1 In data
            Set innerDict = data(key1)
            For Each key2 In innerDict.Keys
                value = innerDict(key2)
                result.Add func(key1, key2, value)
            Next key2
        Next key1
        Set Map = result
    End Function

    ' Filter メソッドの追加
    Public Function Filter(func As Variant) As Collection
        Dim result As New Collection
        Dim key1 As Variant
        Dim key2 As Variant
        Dim value As Variant

        For Each key1 In data
            Set innerDict = data(key1)
            For Each key2 In innerDict.Keys
                value = innerDict(key2)
                If func(key1, key2, value) Then
                    result.Add value, key1 & "_" & key2
                End If
            Next key2
        Next key1
        Set Filter = result
    End Function

    ' Sort メソッドの追加
    Public Sub Sort()
        ' 2次元配列に変換
        Dim arr() As Variant
        Dim key1 As Variant
        Dim key2 As Variant
        Dim i As Integer

        ReDim arr(1 To data.Count, 1 To 3)
        i = 1

        For Each key1 In data
            Set innerDict = data(key1)
            For Each key2 In innerDict.Keys
                arr(i, 1) = key1
                arr(i, 2) = key2
                arr(i, 3) = innerDict(key2)
                i = i + 1
            Next key2
        Next key1

        ' ソート
        QuickSort arr, 1, UBound(arr, 1)

        ' ソート結果を元に戻す
        Clear
        For i = 1 To UBound(arr, 1)
            Add arr(i, 1), arr(i, 2), arr(i, 3)
        Next i
    End Sub

    ' クイックソートの実装
    Private Sub QuickSort(arr() As Variant, low As Integer, high As Integer)
        Dim i As Integer
        Dim j As Integer
        Dim pivot As Variant
        Dim temp As Variant

        i = low
        j = high
        pivot = arr((low + high) \ 2, 3)

        Do
            Do While (arr(i, 3) < pivot)
                i = i + 1
            Loop
            Do While (pivot < arr(j, 3))
                j = j - 1
            Loop
            If (i <= j) Then
                For k = LBound(arr, 2) To UBound(arr, 2)
                    temp = arr(i, k)
                    arr(i, k) = arr(j, k)
                    arr(j, k) = temp
                Next k
                i = i + 1
                j = j - 1
            End If
        Loop While (i <= j)

        If (low < j) Then QuickSort arr, low, j
        If (i < high) Then QuickSort arr, i, high
    End Sub
End Class

このクラスは、2つのキーでアクセスできる辞書構造です。

コンストラクタ (Initialize メソッド)

CustomDictionary クラスの初期化を行います。内部で利用する data 変数を新しい Collection オブジェクトで初期化しています。

Add メソッド

2つのキーと値を指定して辞書に要素を追加します。key1 が外部の辞書のキーであり、key2 が内部の辞書のキーです。Dictionary オブジェクトを使って、外部のキーに対応する内部の辞書を管理します。

Remove メソッド

2つのキーを指定して辞書から要素を削除します。削除後、内部の辞書が空になった場合は外部の辞書からも削除します。

HasKey メソッド

指定した2つのキーが辞書に存在するかどうかを確認します。

Keys メソッド

外部の辞書のキーを取得して新しい Collection オブジェクトに格納して返します。

Values メソッド

内部の辞書の値を取得して新しい Collection オブジェクトに格納して返します。

Clear メソッド

辞書をクリアして初期状態に戻します。

Item メソッド

指定した2つのキーに対応する値を取得します。

PrintData メソッド

辞書全体の内容をデバッグ出力します。

Map メソッド

各要素に対して指定した関数を適用し、その結果を新しい Collection オブジェクトに格納して返します。

Filter メソッド

指定した条件を満たす要素だけを抽出して新しい Collection オブジェクトに格納して返します。

Sort メソッド

要素を指定した順序でソートします。ascending パラメータに True を指定すると昇順、False を指定すると降順でソートします。

PrintSortedData メソッド

ソートされたデータをデバッグ出力します。

これらのメソッドと機能により、CustomDictionary クラスはVBAで2つのキーを持つ辞書構造を実現し、さまざまな操作が可能です。このクラスを利用することで、複雑なデータ構造を簡単に扱うことができます。

まとめ

連想配列はデータベース操作などを直感的に行える様になるなど利用用途は幅広いです。
今回作成した連想配列管理クラスは標準のDictionaryオブジェクトより機能が豊富で使いやすいかと思います。皆さんも様々な関数を追加して、ご自身の業務に役立てて下さい。

EXCEL VBA
こちらもおすすめ！！