VBA
Scripting.Dictionaryオブジェクト
サーチ…
備考
Scripting Dictionaryオブジェクトの初期バインディングを実装するには、VBEのTools→Referencesコマンドを使用してVBAプロジェクトにMicrosoft Scripting Runtimeを追加する必要があります。このライブラリ参照はプロジェクトとともに運ばれます。 VBAプロジェクトが配布されて別のコンピュータで実行されているときに再参照する必要はありません。
プロパティとメソッド
Scripting Dictionaryオブジェクトは、キー/アイテムのペアに情報を格納します。キーは配列ではなくユニークでなければなりませんが、関連付けられたアイテムは繰り返すことができます(一意性はコンパニオンキーによって保持されます)。任意のタイプのバリアントまたはオブジェクトであることができます。
ディクショナリは、最初の「フィールド」( キー )にプライマリユニークインデックスを持つ2フィールドのインメモリデータベースと考えることができます。 Keysプロパティのこの一意のインデックスは、非常に高速な「ルックアップ」がキーの関連するItem値を取得することを可能にします。
プロパティ
名 | 読み書き | タイプ | 説明 |
---|---|---|---|
CompareMode | 読み書き | CompareMode定数 | CompareModeの設定は、空の辞書に対してのみ実行できます。受け入れられる値は、0(vbBinaryCompare)、1(vbTextCompare)、2(vbDatabaseCompare)です。 |
カウント | 読み取り専用 | 符号なし整数 | スクリプティングディクショナリオブジェクト内のキー/アイテムペアの1ベースのカウント。 |
キー | 読み書き | 非配列の変形 | 辞書内の個々の固有のキー。 |
項目( キー ) | 読み書き | 任意の変形 | デフォルトプロパティ。辞書内のキーに関連付けられた個々の項目。ディクショナリに存在しないキーを持つアイテムを取得しようとすると 、渡されたキーが暗黙的に追加されます。 |
メソッド
名 | 説明 |
---|---|
追加( キー 、 アイテム ) | 新しいキーとアイテムを辞書に追加します。新しいキーは、辞書の現在のKeysコレクションに存在してはいけませんが、多くのユニークキーの中でアイテムを繰り返すことができます。 |
存在( キー ) | キーが辞書にすでに存在するかどうかを判断するブールテスト。 |
キー | ユニークキーの配列またはコレクションを返します。 |
アイテム | 関連する項目の配列またはコレクションを返します。 |
削除( キー ) | 個々の辞書キーとその関連アイテムを削除します。 |
すべて削除する | 辞書オブジェクトのすべてのキーとアイテムを消去します。 |
サンプルコード
'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
という名前のワークシートに各ユーザーの最終編集時刻を出力したいとします。
ノート:
1.データはActiveWorkbook
にあるとみなされActiveWorkbook
。
2.配列を使用してワークシートから値を取得しています。これは各セルの反復処理よりも効率的です。
3. Dictionary
は初期バインディングを使用して作成されます。
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}
のみが含まれます。
注:この関数は、任意の列挙可能なオブジェクトで使用できます。