2012年6月24日日曜日

[ExcelVBA] Dictionaryオブジェクト

>Blog Top Page >[ExcelVBA] Top Page >[ExcelVBA] ExcelVBA ALL

呼び名がこれでよいのかよくわからないのだけど、ハッシュだったり連想配列とよばれているものについてのまとめ。
まずは、格納して参照する仕方から。
view plainprint?
  1. Option Explicit  
  2.   
  3. Sub sample()  
  4.     Dim obj As Object  
  5.     Set obj = CreateObject("Scripting.Dictionary")  
  6.     obj.Add "test", 123  
  7.       
  8.     Debug.Print obj.Item("test")  
  9.     Set obj = Nothing  
  10. End Sub  
４行目：型の宣言
５行目：オブジェクトの作成
６行目：Addメソッドでキーに対する値をセット
８行目：Itemメソッドに引数にキーを渡し値を表示
オブジェクト名.Item(キー名)
※注：キーにセルの値を渡したい時、Range("A1")のように.Valueを省略すると
Rangeオブジェクトがキーに渡されて期待した動きをしません。
RangeやCellsで値を渡したい時は、Range("A1").Valueのようにする必要があります。



Add/Item以外のメソッドやプロパティは･･･
■Exists(キーが存在するか調べる)
view plainprint?
  1. Option Explicit  
  2.   
  3. Sub sample()  
  4.     Dim obj As Object  
  5.     Set obj = CreateObject("Scripting.Dictionary")  
  6.     obj.Add "test", 123  
  7.       
  8.     Debug.Print obj.Exists("test") 'True←存在してるキーだから  
  9.     Debug.Print obj.Exists("te") 'False←存在していないキーだから  
  10.     Set obj = Nothing  
  11. End Sub  



■Key(キーを変更する)
view plainprint?
  1. Option Explicit  
  2.   
  3. Sub sample()  
  4.     Dim obj As Object  
  5.     Set obj = CreateObject("Scripting.Dictionary")  
  6.     obj.Add "test", 123  
  7.       
  8.     Debug.Print obj.Item("test") '123  
  9.     Debug.Print obj.Exists("testes") 'False:まだ存在していないキー  
  10.     obj.key("test") = "testes" 'testキーからtestesキーへ変更  
  11.       
  12.     Debug.Print obj.Item("testes") '123  
  13.     Debug.Print obj.Exists("test") 'testキーは消滅  
  14.     Set obj = Nothing  
  15. End Sub  



■Remove(キーを削除する)
view plainprint?
  1. Option Explicit  
  2.   
  3. Sub sample()  
  4.     Dim obj As Object  
  5.     Set obj = CreateObject("Scripting.Dictionary")  
  6.     obj.Add "test", 123  
  7.       
  8.     MsgBox obj.Exists("test") 'True  
  9.     obj.Remove ("test") 'testキーを削除  
  10.     Debug.Print obj.Exists("test") 'False   
  11.     Set obj = Nothing  
  12. End Sub  



■RemoveAll(全てのキーを削除)
view plainprint?
  1. Option Explicit  
  2.   
  3. Sub sample()  
  4.     Dim obj As Object  
  5.     Set obj = CreateObject("Scripting.Dictionary")  
  6.     obj.Add "test", 123  
  7.       
  8.     Debug.Print obj.Exists("test") 'True  
  9.     obj.RemoveAll '全てのキーを削除  
  10.     Debug.Print obj.Exists("test") 'False  
  11.     Set obj = Nothing  
  12. End Sub  



■Count(キーの数を返します)
view plainprint?
  1. Option Explicit  
  2.   
  3. Sub sample()  
  4.     Dim obj As Object  
  5.     Set obj = CreateObject("Scripting.Dictionary")  
  6.     obj.Add "test", 123  
  7.       
  8.     Debug.Print obj.Count '１  
  9.     Set obj = Nothing  
  10. End Sub  


■For Eachでキーと値を表示
view plainprint?
  1. Option Explicit  
  2.   
  3. Sub sample()  
  4.     Dim obj As Object  
  5.     Dim key As Variant  
  6.       
  7.     Set obj = CreateObject("Scripting.Dictionary")  
  8.     obj.Add "a", 111  
  9.     obj.Add "b", 222  
  10.     obj.Add "c", 333  
  11.     obj.Add "d", 444  
  12.       
  13.     For Each key In obj  
  14.         Debug.Print "キー名：" & key & ", 値：" & obj.Item(key)  
  15.     Next key  
  16.     Set obj = Nothing  
  17. End Sub  


■For文でキーと値を表示
view plainprint?
  1. Option Explicit  
  2.   
  3. Sub sample()  
  4.     Dim obj As Object  
  5.     Dim i As Integer  
  6.       
  7.     Set obj = CreateObject("Scripting.Dictionary")  
  8.     obj.Add "a", 111  
  9.     obj.Add "b", 222  
  10.     obj.Add "c", 333  
  11.     obj.Add "d", 444  
  12.       
  13.     For i = 0 To obj.count - 1  
  14.         Debug.Print "キー名：" & obj.keys()(i) & ", 値：" & obj.Items()(i)  
  15.     Next  
  16.     Set obj = Nothing  
  17. End Sub  




これらを踏まえて、以下の状況を考えてみます。
３人の生徒における４教科のテスト結果を変数に格納してる場合どうすればよいか？

ここでは、太郎、次郎、三郎の３人に対し、国語、算数、理科、社会の
４教科のそれぞれを乱数で点数を決定し値を格納し、それをdebug.printで
出力してみたいと思います。

view plainprint?
  1. Option Explicit  
  2.   
  3. Sub SampleCode()  
  4.     Dim Score As Object, Person As Object  
  5.     Set Score = CreateObject("Scripting.Dictionary")  
  6.       
  7.     Dim PersonalName As Variant: PersonalName = Array("太郎", "次郎", "三郎") '人名の準備  
  8.     Dim SubjectName As Variant: SubjectName = Array("国語", "算数", "理科", "社会") '科目の準備  
  9.               
  10.     Dim i As Integer, ii As Integer  
  11.     For i = 0 To UBound(PersonalName) '人名でループ  
  12.         Set Person = CreateObject("Scripting.Dictionary") '格納する為の準備  
  13.           
  14.         For ii = 0 To UBound(SubjectName) '人名ごとの科目でループ  
  15.             Person.Add SubjectName(ii), Int(Rnd() * 101) '科目名、点数  
  16.         Next  
  17.           
  18.         Score.Add PersonalName(i), Person '人名, オブジェクト(科目名と点数のセット)  
  19.         Set Person = Nothing '不要になったら破棄  
  20.     Next  
  21.   
  22.   
  23.     '以降　出力  
  24.     Dim PersonKey As Variant, SubjectKey As Variant  
  25.     For Each PersonKey In Score 'まずは人名を取り出す  
  26.         Debug.Print "[" & PersonKey & "]"  
  27.   
  28.         For Each SubjectKey In Score.Item(PersonKey)  
  29.             Debug.Print "　" & SubjectKey & "：" & Score.Item(PersonKey).Item(SubjectKey)  
  30.         Next  
  31.     Next  
  32.       
  33.     Set Score = Nothing  
  34. End Sub  


出力参考：
[太郎]
国語：87
算数：79
理科：37
社会：97
[次郎]
国語：88
算数：5
理科：95
社会：36
[三郎]
国語：53
算数：77
理科：5
社会：59

便利ですね。



■応用編(色んなObjectを組み合わせる)
もっと複雑な組み合わせにすることも可能です。
例えば、以下の情報を持ちたいとします。


今回はこういうデータ構造にしてみたいと思います。
学年をキーに、値をDictionaryにします。
そのDictionaryは、名前をキーに値をDictionaryを持ちます
そのDictionaryは、値に身長、趣味を持ち
身長は、値に数値を持ち
趣味は、値にCollectionを持つとします。

"学年" => {(Dictionary)
          名前 => {(Dictionary)
                  身長 => 数値,
                  趣味 => {(Collection) 文字列}
                  }
           }
今回は、学年内で名前は重複しないという前提にします。
view plainprint?
  1. Option Explicit  
  2.   
  3. Sub Sample()  
  4.     Dim obj As Object  
  5.     Set obj = CreateObject("Scripting.Dictionary")  
  6.       
  7.     Dim r As Long, EndRow As Long  
  8.     EndRow = Range("A65536").End(xlUp).Row '最終行取得  
  9.       
  10.     Dim CellGrade As String, CellName As String, CellTall As String  
  11.     Dim CellHobby1 As String, CellHobby2 As String, CellHobby3 As String  
  12.     For r = 2 To EndRow  
  13.         '値を取得  
  14.         CellGrade = Range("A" & r)  
  15.         CellName = Range("B" & r)  
  16.         CellTall = Range("C" & r)  
  17.         CellHobby1 = Range("D" & r)  
  18.         CellHobby2 = Range("E" & r)  
  19.         CellHobby3 = Range("F" & r)  
  20.           
  21.         '学年名が既にキーに登録されているか調べる  
  22.         If Not obj.Exists(CellGrade) Then  
  23.         '登録されていない  
  24.             '学年の登録  
  25.             obj.Add CellGrade, CreateObject("Scripting.Dictionary") '値にDictionary  
  26.         End If  
  27.           
  28.         '名前の登録  
  29.         obj.Item(CellGrade).Add CellName, CreateObject("Scripting.Dictionary")  
  30.         '身長の登録  
  31.         obj.Item(CellGrade).Item(CellName).Add "身長", CellTall  
  32.         '趣味を登録  
  33.         obj.Item(CellGrade).Item(CellName).Add "趣味", New Collection  
  34.         If CellHobby1 <> "" Then _  
  35.             obj.Item(CellGrade).Item(CellName).Item("趣味").Add CellHobby1  
  36.         If CellHobby2 <> "" Then _  
  37.             obj.Item(CellGrade).Item(CellName).Item("趣味").Add CellHobby2  
  38.         If CellHobby3 <> "" Then _  
  39.             obj.Item(CellGrade).Item(CellName).Item("趣味").Add CellHobby3  
  40.     Next  
  41.   
  42.     Set obj = Nothing  
  43. End Sub  

ここで補足があります。
このように深い階層になってくると何度もItem(キー)でつないでいくことになるのですが
コードが横長になって見づらくなってしまいます。
ただし、Itemは省略することが可能なため
obj.Item(CellGrade).Item(CellName).Item("趣味").Add CellHobby1
を
obj(CellGrade)(CellName)("趣味").Add CellHobby1
と書くこともきます。

>Blog Top Page >[ExcelVBA] Top Page >[ExcelVBA] ExcelVBA ALL
時刻:
ラベル:

0 件のコメント:

コメントを投稿

登録: コメントの投稿 (Atom)