VBA100本ノック57本目の題材をヒントにDictionaryオブジェクトのデータ(Item)に配列を使う方法について解説します。
通常、Dictionaryオブジェクトは1つのKeyに1つのデータ(Item)となりますが、DictionaryオブジェクトのKeyに配列を使うことで、複数のデータ(Item)を紐づけることができます。
基本的なDictionaryの使い方についてはこちらの記事をご覧ください。↓↓

配列を使った問題
「商品名」、「仕入先」、「仕入日」の3つのフィールドあり、商品名フィールドには重複データがあります。重複した商品名のうち仕入日が最新ではないものはE列以降に出力します。
わかりやすいように商品重複レコード(削除項目)は赤字にしています。

コードを実行すると以下のようになります。

VBAコード
Sub ディクショナリテスト()
Dim Dic As Dictionary
Set Dic = New Dictionary
Dim Col As Collection
Set Col = New Collection
Dim i As Integer
Range(Cells(3, 5), Cells(Cells(Rows.Count, 7).End(xlUp).Row + 1, 7)).ClearContents
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If Not Dic.Exists(Cells(i, 1).Value) Then 'キー:商品名が存在しなければ
Dic.Add Cells(i, 1).Value, Array(Cells(i, 1).Value, Cells(i, 2).Value, Cells(i, 3).Value) 'キーに配列データを追加
End If
If Cells(i, 3).Value > Dic(Cells(i, 1).Value)(2) Then '仕入日がディクショナリに追加されたデータより大きければ
Col.Add Dic(Cells(i, 1).Value) 'コレクションの中にディクショナリデータが追加される。
Dic(Cells(i, 1).Value) = Array(Cells(i, 1), Cells(i, 2).Value, Cells(i, 3).Value) '新たなキーとデータが追加更新される。
ElseIf Cells(i, 3).Value < Dic(Cells(i, 1).Value)(2) Then '仕入日がディクショナリに追加されたデータより小さければ
Col.Add Array(Cells(i, 1).Value, Cells(i, 2).Value, Cells(i, 3).Value) 'コレクションの中にデータが追加される
End If
Next i
Dim vItem
Dim r As Integer
r = Cells(Rows.Count, 5).End(xlUp).Row + 1
For Each vItem In Col 'コレクションの中の削除データが5列目以降に出力される
Range(Cells(r, 5), Cells(r, 7)) = vItem
r = r + 1
Next
End Sub
コード概要
- (10行目)ForNextステートメントで1レコードずつ判別をしていきます。
- (11~13行)商品名をkeyにして、配列を使って「商品名」「仕入先」「仕入日」をItemに格納します
- (15~20行)削除レコードはCollectionオブジェクトに格納されるアルゴリズムです。
商品名のKeyがすでに存在すれば、Itemの「仕入日」と「仕入日」フィールドのデータを比較します。
仕入日データが既に格納されているItemの「仕入日」より最新ならばディクショナリーのItemは更新(上書き)されます。そして、ディクショナリーに既にあったItemはコレクションオブジェクトに格納されます。
仕入日データが最新でなければ、Collectionオブジェクトに格納されます。 - (23~29行)Collectionオブジェクトに格納されているデータ(仕入日が最新ではないデータ)は【削除項目】に出力されます。
Collectionオブジェクトの基本についてはこちらの記事で↓

ForNextステートメント(繰り返し処理)についてはこちらの記事で↓

配列の活用
If Not Dic.Exists(Cells(i, 1).Value) Then
Dic.Add Cells(i, 1).Value, Array(Cells(i, 1).Value, Cells(i, 2).Value, Cells(i, 3).Value)
End If
11~13行目:Dictionaryオブジェクトに各「商品名」をキーにして、データ(Item)を配列にして追加します。データは以下のように格納されます。
つまり、データを配列にすることで、キーの中にデータ(Item)を複数入れることができます。

データ(Item)の中の配列データはDictionaryオブジェクト名(キー)(配列インデックス番号)で取り出すことができます。
15行目:Dic(Cells(i, 1).Value)(2)
とすればデータ(Item)の配列番号(2)の日付データを取り出すことができます。
Array関数
Array関数・・Array(引数1,引数2、引数3、・・・)
配列として格納するデータをカンマ区切りで指定します。配列データを返してくれます。
Array関数の事例
ワークシート上の各セルにデータがあります。

Sub 配列()
Dim St As Variant'バリアント型の変数
St = Array(Cells(1, 1).Value, Cells(1, 2).Value, Cells(1, 3).Value)'変数に配列データを代入
MsgBox St(0)
End Sub
コードを実行すると・・・・

配列として宣言していないバリアント型変数に、データが配列形式で代入されます。

MsgBox St(0)
変数名(配列インデックス番号)で配列データを取り出せます。
条件分岐
If Cells(i, 3).Value > Dic(Cells(i, 1).Value)(2) Then '仕入日がディクショナリに追加されたデータより大きければ
Col.Add Dic(Cells(i, 1).Value) 'コレクションの中にディクショナリデータが追加される。
Dic(Cells(i, 1).Value) = Array(Cells(i, 1), Cells(i, 2).Value, Cells(i, 3).Value) '新たなキーとデータが上書きされる。
ElseIf Cells(i, 3).Value < Dic(Cells(i, 1).Value)(2) Then '仕入日がディクショナリに追加されたデータより小さければ
Col.Add Array(Cells(i, 1).Value, Cells(i, 2).Value, Cells(i, 3).Value) 'コレクションの中にデータが追加される
End If
15~17行目:既にDictionaryオブジェクトに格納されている配列データのインデックス番号(2)の要素である「仕入日」とワークシート上の「仕入日」を比較します。
ワークシート上の「仕入日」がDictionaryに格納されているデータの仕入日より大きければ(日付が最新ならば)、Dictionaryオブジェクトに新たなキーとデータが上書きされます。
そして、Dictionaryに元々格納されていたキーとデータはコレクションの中に追加されます。
18~20行目:反対にワークシート上の仕入日が小さければ、ワークシートのレコードがコレクションに格納されます。
もちろん、キー自体が存在しない場合は、次の項目に進みます。(条件分岐はスルーされます)
Collectionオブジェクト
Dim vItem
Dim r As Integer
r = Cells(Rows.Count, 5).End(xlUp).Row + 1
For Each vItem In Col 'コレクションの中の削除データが5列目以降に出力される
Range(Cells(r, 5), Cells(r, 7)) = vItem
r = r + 1
Next
23~29行目:Collectionオブジェクトに格納されている削除項目を5~7列目に出力しています。
そもそもCollectionオブジェクトとは、複数の要素の集合です。異なるデータ型を要素とすることができます。
筆者オススメのVBAの本はこちら↓↓

Addメソッド
CollectionオブジェクトのAddメソッドでCollectionオブジェクトにメンバーを追加できます。
Collectionオブジェクト.Add Item(追加するメンバー)
16行目:Col.Add Dic(Cells(i, 1).Value)
19行目:Col.Add Array(Cells(i, 1).Value, Cells(i, 2).Value, Cells(i, 3).Value)
上記コードでCollectionオブジェクトにメンバーが追加されていきます。今回は削除するデータを配列形式で追加しています。


まとめ
Dictionaryオブジェクトのデータを配列にする方法について解説しました。Dictionaryのデータ(Item)を複数紐づけることができるメリットがあります。是非、参考にしてみてください。
コメント