VBA
Scripting.Dictionaryオブジェクト

備考

プロパティとメソッド

Scripting Dictionaryオブジェクトは、キー/アイテムのペアに情報を格納します。キーは配列ではなくユニークでなければなりませんが、関連付けられたアイテムは繰り返すことができます（一意性はコンパニオンキーによって保持されます）。任意のタイプのバリアントまたはオブジェクトであることができます。

ディクショナリは、最初の「フィールド」（ キー ）にプライマリユニークインデックスを持つ2フィールドのインメモリデータベースと考えることができます。 Keysプロパティのこの一意のインデックスは、非常に高速な「ルックアップ」がキーの関連するItem値を取得することを可能にします。

プロパティ

メソッド

サンプルコード

'Populate, enumerate, locate and remove entries in a dictionary that was created
'with late binding
Sub iterateDictionaryLate()
    Dim k As Variant, dict As Object
    
    Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare          'non-case sensitive compare model
    
    'populate the dictionary
    dict.Add Key:="Red", Item:="Balloon"
    dict.Add Key:="Green", Item:="Balloon"
    dict.Add Key:="Blue", Item:="Balloon"
    
    'iterate through the keys
    For Each k In dict.Keys
        Debug.Print k & " - " & dict.Item(k)
    Next k

    'locate the Item for Green
    Debug.Print dict.Item("Green")
    
    'remove key/item pairs from the dictionary
    dict.Remove "blue"      'remove individual key/item pair by key
    dict.RemoveAll          'remove all remaining key/item pairs

End Sub

'Populate, enumerate, locate and remove entries in a dictionary that was created
'with early binding (see Remarks)
Sub iterateDictionaryEarly()
    Dim d As Long, k As Variant
    Dim dict As New Scripting.Dictionary
    
    dict.CompareMode = vbTextCompare          'non-case sensitive compare model
    
    'populate the dictionary
    dict.Add Key:="Red", Item:="Balloon"
    dict.Add Key:="Green", Item:="Balloon"
    dict.Add Key:="Blue", Item:="Balloon"
    dict.Add Key:="White", Item:="Balloon"
    
    'iterate through the keys
    For Each k In dict.Keys
        Debug.Print k & " - " & dict.Item(k)
    Next k

    'iterate through the keys by the count
    For d = 0 To dict.Count - 1
        Debug.Print dict.Keys(d) & " - " & dict.Items(d)
    Next d
    
    'iterate through the keys by the boundaries of the keys collection
    For d = LBound(dict.Keys) To UBound(dict.Keys)
        Debug.Print dict.Keys(d) & " - " & dict.Items(d)
    Next d
    
    'locate the Item for Green
    Debug.Print dict.Item("Green")
    'locate the Item for the first key
    Debug.Print dict.Item(dict.Keys(0))
    'locate the Item for the last key
    Debug.Print dict.Item(dict.Keys(UBound(dict.Keys)))
    
    'remove key/item pairs from the dictionary
    dict.Remove "blue"                         'remove individual key/item pair by key
    dict.Remove dict.Keys(0)                   'remove first key/item by index position
    dict.Remove dict.Keys(UBound(dict.Keys))   'remove last key/item by index position
    dict.RemoveAll                             'remove all remaining key/item pairs

End Sub

Scripting.Dictionary（最大、数）でデータを集計する

辞書は、複数のエントリが存在する情報を管理するのに最適ですが、最初の値または最後の値、最小値または最大値、平均値、合計値など、各エントリの1つの値にのみ関係します。

誰かがブックを編集するたびに、ユーザー名と編集日を挿入するスクリプトを使用して、ユーザーアクティビティのログを保持するブックを検討してください。

Logワークシート

A	B
ボブ	10/12/2016 9:00
アリス	10/13/2016 13:00
ボブ	2013年10月13日13:30
アリス	10/13/2016 14:00
アリス	10/14/2016 13:00

Summaryという名前のワークシートに各ユーザーの最終編集時刻を出力したいとします。

<sup>ノート：
1.データはActiveWorkbookにあるとみなされActiveWorkbook 。
2.配列を使用してワークシートから値を取得しています。これは各セルの反復処理よりも効率的です。
3. Dictionaryは初期バインディングを使用して作成されます。</sup>

Sub LastEdit()
Dim vLog as Variant, vKey as Variant
Dim dict as New Scripting.Dictionary
Dim lastRow As Integer, lastColumn As Integer
Dim i as Long
Dim anchor As Range

With ActiveWorkbook
    With .Sheets("Log")
        'Pull entries in "log" into a variant array
        lastRow = .Range("a" & .Rows.Count).End(xlUp).Row
        vlog = .Range("a1", .Cells(lastRow, 2)).Value2

        'Loop through array
        For i = 1 to lastRow
            Dim username As String
            username = vlog(i, 1)
            Dim editDate As Date
            editDate = vlog(i, 2)

            'If the username is not yet in the dictionary:
            If Not dict.Exists(username) Then
                dict(username) = editDate
            ElseIf dict(username) < editDate Then
                dict(username) = editDate
            End If
        Next
    End With

    With .Sheets("Summary")
        'Loop through keys
        For Each vKey in dict.Keys
            'Add the key and value at the next available row
            Anchor = .Range("A" & .Rows.Count).End(xlUp).Offset(1,0)
            Anchor = vKey
            Anchor.Offset(0,1) = dict(vKey)
        Next vKey
    End With
End With
End Sub

出力は次のようになります。

Summaryワークシート

A	B
ボブ	2013年10月13日13:30
アリス	10/14/2016 13:00

一方、各ユーザーがブックを編集した回数を出力したい場合、 Forループの本文は次のようになります。

        'Loop through array
        For i = 1 to lastRow
            Dim username As String
            username = vlog(i, 1)

            'If the username is not yet in the dictionary:
            If Not dict.Exists(username) Then
                dict(username) = 1
            Else
                dict(username) = dict(username) + 1
            End If
        Next

出力は次のようになります。

Summaryワークシート

A	B
ボブ	2
アリス	3

Scripting.Dictionaryでユニークな値を取得する

Dictionaryは、一意の値セットを非常に簡単に取得できます。以下の関数を考えてみましょう：

Function Unique(values As Variant) As Variant()
    'Put all the values as keys into a dictionary
    Dim dict As New Scripting.Dictionary
    Dim val As Variant
    For Each val In values
        dict(val) = 1 'The value doesn't matter here
    Next
    Unique = dict.Keys
End Function

あなたはこれを次のように呼び出すことができます：

Dim duplicates() As Variant
duplicates = Array(1, 2, 3, 1, 2, 3)
Dim uniqueVals() As Variant
uniqueVals = Unique(duplicates)

uniqueValsは{1,2,3}のみが含まれます。

注：この関数は、任意の列挙可能なオブジェクトで使用できます。