Deprecated: The each() function is deprecated. This message will be suppressed on further calls in /home/zhenxiangba/zhenxiangba.com/public_html/phproxy-improved-master/index.php on line 456
Dictionaryを利用する:Excel VBA入門

Dictionaryオブジェクトを利用する:Excel VBA入門

スポンサードリンク

Dictionaryオブジェクトを利用する方法を書いていますが、理解不足で間違った説明をしているかもしれません。
Dictionaryオブジェクトはデータキーと組みとなる項目を格納するオブジェクト。
項目は重複しないキーで関連付けられる。キーは各項目を取得するのに使用され、通常、整数型か文字列型。

Dictionaryオブジェクトを作成する　　　topへ

下表の品名と単価をmyDicに格納して、D列の品名に応じた単価をE列に返します。
なお、この例ではA列の品名は重複していないデータです。
CreateObject関数で、Dictionaryオブジェクト[myDic]を生成します。
Addメソッド[object.Add key, item] でKey[品名(A2)],Item[単価(B2)]を順次格納します。

Itemプロパティ【object.Item(key)[ = newitem]】でD列のKeyに関連付けられたItemをE列へ取り出します。

Sub dic0_1()
　Dim myDic As Object, myKey
　Dim c, myVal
　Dim i As Long
　　Set myDic = CreateObject("Scripting.Dictionary")
　　'---myDicにKeyとItemを格納する
　　For i = 2 To 7
　　　　myDic.Add Cells(i, 1).Value, Cells(i, 2).Value
　　Next i
　　'---Itemを取り出す
　　For i = 2 To 7
　　　　Cells(i, 5).Value = myDic.Item(Cells(i, 4).Value)
　　Next i

　Set myDic = Nothing
End Sub

実行すると、下図になります。

myDic.Add Cells(i, 1).Value, Cells(i, 2).ValueはmyDic(Cells(i, 1).Value) = Cells(i, 2).Valueと書くこともできます。
myDic(key)=item　keyにitemを書き込む・・・といった形式です。

Cells(i, 5).Value = myDic.Item(Cells(i, 4).Value)はCells(i, 5).Value = myDic(Cells(i, 4).Value)と書くこともできます。

Keyが重複するときは注意が必要です。最後のitemが上書きされます。
このような書き方ですとエラーは出ません。すでに存在しているkeyのitemを置き換えます。

Sub dic0_1a()
　Dim myDic As Object, myKey
　Dim c, myVal
　Dim i As Long
　　Set myDic = CreateObject("Scripting.Dictionary")
　　'---myDicにKeyとItemを格納する
　　For i = 2 To 7
　　　　myDic(Cells(i, 1).Value) = Cells(i, 2).Value
　　Next i
　　'---Itemを取り出す
　　For i = 2 To 7
　　　　Cells(i, 5).Value = myDic.Item(Cells(i, 4).Value)
　　Next i

　Set myDic = Nothing
End Sub

↓

ところが、A列の品名が重複していると、上のコードSub dic0_1()のmyDic.Add Cells(i, 1).Value, Cells(i, 2).Valueはエラーになってしまいます。
重複したKeyは登録できないからです。
下表はA2とA5に「みかん」が重複しています。
つまり、「みかん」というkeyは既に存在しているのに、.Addで「みかん」を追加せよ!となるのでエラーとなります。

Existsメソッド　[object.Exists(key)]を利用して、Not演算子と組み合わせ、Keyが存在しないときは追加するようにします。

Sub dic0_12()
　Dim myDic As Object, myKey
　Dim c, myVal
　Dim i As Long
　　Set myDic = CreateObject("Scripting.Dictionary")
　　'---myDicにKeyとItemを格納する
　　For i = 2 To 7
　　　　 If Not myDic.exists(Cells(i, 1).Value) Then
　　　　　　myDic.Add Cells(i, 1).Value, Cells(i, 2).Value
　　　　End If
　　Next i
　　'---Itemを取り出す
　　For i = 2 To 7
　　　　Cells(i, 5).Value = myDic.Item(Cells(i, 4).Value)
　　Next i

　Set myDic = Nothing
End Sub

実行すると下図のようになります。
- キーが重複している時は2つ目以降は無視しますので、上記例では「みかん」の単価は「100」となります。
  このコードでは単価の「130」は無視するようになっています。
  Sub dic0_1a()の結果と異なることに注意してください。
- 実際は同じ品名で単価が異なるというのはおかしいですよね・・・あくまでも例ですので細かいところは見逃してください。

重複しないリストを生成する　　　topへ

下表のようなA列の文字列データから重複しない文字列をD列に表示します　　　topへ

【例1】

ここのコードは、元データを配列myValに読み込んで処理しています。
この例ではitemは必要ないので""としています。

Sub rei21_1()
　Dim myDic As Object, myKey
　Dim c, myVal
　Dim i As Long
　Set myDic = CreateObject("Scripting.Dictionary")
　' ---(1)元データを配列に格納
　myVal = Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
　　　' ---(2)myDicへデータを格納
　　　For Each c In myVal
　　　　　If Not c = Empty Then
　　　　　　　If Not myDic.Exists(c) Then
　　　　　　　　　myDic.Add c, ""
　　　　　　　End If
　　　　　End If
　　　Next
　　　' ---(3)Keyの書き出し
　　　myKey = myDic.Keys
　　　For i = 0 To myDic.Count - 1
　　　　　Cells(i + 2, 4) = myKey(i)
　　　Next i
　Set myDic = Nothing
End Sub

' ---(3)Keyの書き出しの部分はワークシート関数を利用して以下のように書くこともできます。

' ---(3)Keyの書き出し
myKey = myDic.keys
Range("D2").Resize(myDic.Count) = Application.WorksheetFunction.Transpose(myKey)

(1)A2からA列最終行までの値を、配列myValに格納
(2)myValの値が空でなかったら、更に、myDicその値が存在していなかったらmyDicに追加。
この時、Itemには""を入れておく。この例では重複していないKeyがほしいのであって、Itemは関係ないので何が入っていてもよいのです。
大抵の場合は、次の例のように計算値が入ったりします。
(3)myDicのKeyをD2以降に書き出す。

重複しない品名と個数の合計を計算します　　　topへ

【例2】

Sub rei21_2()
　Dim myDic As Object, myKey, myItem
　Dim myVal
　Dim i As Long
　　Set myDic = CreateObject("Scripting.Dictionary")
　　Range("D2", Range("E" & Rows.Count).End(xlUp)).ClearContents
　　Range("D1:E1").Value = Range("A1:B1").Value
　　' ---元データを配列に格納
　　myVal = Range("A2", Range("A" & Rows.Count).End(xlUp)).Resize(, 2).Value
　　' ---myDicへデータを格納
　　　　For i = 1 To UBound(myVal, 1)
　　　　　　If Not myVal(i, 1) = Empty Then
　　　　　　　　If Not myDic.exists(myVal(i, 1)) Then
　　　　　　　　　　'---新たなkeyの時はkeyとitemを追加します
　　　　　　　　　　myDic.Add myVal(i, 1), myVal(i, 2)
　　　　　　　　Else
　　　　　　　　　　'---すでに存在しているkeyの時はitemを加算します
　　　　　　　　　　myDic(myVal(i, 1)) = myDic(myVal(i, 1)) + myVal(i, 2)
　　　　　　　　End If
　　　　　　End If
　　　　Next
　　' ---Key,Itemの書き出し
　　myKey = myDic.keys
　　myItem = myDic.items
　　　　For i = 0 To UBound(myKey)
　　　　　　Cells(i + 2, 4).Value = myKey(i)
　　　　　　Cells(i + 2, 5).Value = myItem(i)
　　　　Next
　　Set myDic = Nothing
End Sub

' ---Key,Itemの書き出しの部分はワークシート関数を利用して以下のように書くこともできます。

' ---Key,Itemの書き出し
myKey = myDic.keys
myItem = myDic.items
　　Range("D2").Resize(myDic.Count) = Application.WorksheetFunction.Transpose(myKey)
　　Range("E2").Resize(myDic.Count) = Application.WorksheetFunction.Transpose(myItem)

2つの条件で合計する　　　topへ

【例3】

2つの条件を結合して1つにしています。myVal2 = myVal(i, 1) & "_" & myVal(i, 2)の部分。
これで条件が1つのケースと同じです。
書き出す時にmyVal3 = Split(myKey(i), "_")　として2つに分けています。

Sub rei21_3()
　Dim myDic As Object, myKey, myItem
　Dim myVal, myVal2, myVal3
　Dim i As Long
　　Range("E2", Range("G" & Rows.Count).End(xlUp)).ClearContents
　　Range("E1:G1").Value = Range("A1:C1").Value
　　Set myDic = CreateObject("Scripting.Dictionary")
　　' ---元データを配列に格納
　　myVal = Range("A2", Range("A" & Rows.Count).End(xlUp)).Resize(, 3).Value
　　' ---myDicへデータを格納
　　　　For i = 1 To UBound(myVal, 1)
　　　　　　myVal2 = myVal(i, 1) & "_" & myVal(i, 2)
　　　　　　If Not myVal2 = "_" Then
　　　　　　　　If Not myDic.exists(myVal2) Then
　　　　　　　　　　myDic.Add myVal2, myVal(i, 3)
　　　　　　　　Else
　　　　　　　　　　myDic(myVal2) = myDic(myVal2) + myVal(i, 3)
　　　　　　　　End If
　　　　　　End If
　　　　Next
　　' ---Key,Itemの書き出し
　　myKey = myDic.keys
　　myItem = myDic.items
　　　　For i = 0 To UBound(myKey)
　　　　　　myVal3 = Split(myKey(i), "_")
　　　　　　Cells(i + 2, 5).Value = myVal3(0)
　　　　　　Cells(i + 2, 6).Value = myVal3(1)
　　　　　　Cells(i + 2, 7).Value = myItem(i)
　　　　Next
　　Set myDic = Nothing
　　' ---並べ替え
　　Range("E1", Range("G" & Rows.Count).End(xlUp)).Sort _
　　　　Key1:=Range("E2"), Order1:=xlAscending, _
　　　　Key2:=Range("F2"), Order2:=xlAscending, _
　　　　Header:=xlGuess
End Sub

プロパティ　　　 topへ

CompareModeプロパティ

文字列比較キーの比較モードを設定します。

object.CompareMode =	値	内容
vbBinaryCompare	0	バイナリモード　大文字小文字を区別します。
vbTextCompare	1	テキストモード　大文字小文字を区別しない
vbDatabaseCompare	2	Accessの場合のみ有効

Countプロパティ　[object.Count]
- Dictionary オブジェクトに格納される項目の数を返します。
Itemプロパティ　【object.Item(key)[ = newitem]】
- Dictionary オブジェクトにある指定されたキーと関連付ける項目を設定します。
  コレクションの場合、指定されたキーを基に項目を返します。
  - key：必ず指定します。取得または追加する項目と関連付けるキーを指定します。
    newitem：省略可能です。引数 key で指定した値と関連付ける新しい項目を指定します。
Keyプロパティ　[object.Key(key) = newkey]
- Dictionary オブジェクトにキーを設定します。
  - key：必ず指定します。変更するキーを指定します。
    newkey：必ず指定します。引数keyで指定した値と置き換える新しいキーを指定します。

メソッド　　　 topへ

Addメソッド　[object.Add key, item]
- Dictionary オブジェクトにキーと対の項目を追加します。
  - Key：必ず指定します。追加する引数 item と関連付けられた引数 key を指定します。
    Item：必ず指定します。追加する引数 key と関連付けられた引数 item を指定します。
Existsメソッド　[object.Exists(key)]
- 指定されたキーが Dictionary オブジェクトの中に存在する場合は、真 (True) を返します。存在しない場合は、偽 (False) を返します。
  - key：必ず指定します。Dictionary オブジェクトの中から検索するキーの値を指定します。
Itemsメソッド　[object.Items]
- Dictionary オブジェクトのすべての項目に含まれる配列を返します。
Keysメソッド　[object.Keys]
- Dictionary オブジェクトにあるすべてのキーに含まれる配列を返します。
Removeメソッド　[object.Remove(key)]
- Dictionary オブジェクトからキーと項目の組みを削除します。
  - key：必ず指定します。Dictionary オブジェクトから削除するキーと項目の組みと関連付けられた引数 Key を指定します。
RemoveAllメソッド　[object.RemoveAll]
- Dictionary オブジェクトからすべてのキーと項目を削除します。

スポンサードリンク

よねさんのWordとExcelの小部屋｜Excel(エクセル)講座の総目次｜Excel(エクセル) VBA入門：目次｜Dictionaryオブジェクトを利用する

PageViewCounter
　 Counter
　Since2006/2/27

Dictionaryオブジェクトを利用する:Excel VBA入門

Dictionaryオブジェクトを作成する topへ

重複しないリストを生成する topへ

下表のようなA列の文字列データから重複しない文字列をD列に表示します topへ

重複しない品名と個数の合計を計算します topへ

2つの条件で合計する topへ

プロパティ topへ

メソッド topへ