Scripting.Dictionaryについて

質問

オートフィルタで抽出した値をリストボックスに代入する為の
コードがあります。
前任者が書いたコードですが、何とか動作を確認しながら
変更しようとしたのですが、わかりませんでした。

やりたいこと
Application.Intersect(SS, SS.Offset(1)).Copyからxに格納した
値をmyList(i, 1) = xでリストボックスに入れたい。

問題点
　　　　For i = 0 To UBound(v) - 1
.Item(v(i)) = .Item(v(i)) + 1 'アイテムのカウント
Next
上記の後に
　　　　For Each v In .Keys
i = i + 1
myList(i, 0) = v '8行目の値
myList(i, 1) = x '9行目の値を入れたい
myList(i, 2) = .Item(v) '8行目のカウント数
Next
が実行される際にｖの値が重複を除いて、順番にリストに
入る動作が理解できません。
どなたかアドバイスお願いします。

Private Sub ComboBox1_Change()
Dim 開始日 As Date
Dim 終了日 As Date
Dim i, ii As Long, v, x As Variant
Dim Sh1 As Worksheet
Set Sh1 = Sheets("日報")

Set RR = Sh1.Range("A4").CurrentRegion
Set CC = RR.Columns(8)
Set SS = RR.Columns(9)
開始日 = DateValue(ComboBox1.Value)
終了日 = DateSerial(Year(開始日), Month(開始日) + 1, Day(開始日)) - 1

RR.Worksheet.AutoFilterMode = False ' B列 開始日から月末までの期間を抽出
RR.AutoFilter Field:=1, _
Criteria1:=">=" & 開始日, Operator:=xlAnd, _
Criteria2:="<=" & 終了日

Application.Intersect(CC, CC.Offset(1)).Copy '8行目をコピー
With New DataObject
.GetFromClipboard
v = Split(.GetText, vbCrLf) 'vに代入
Application.Intersect(SS, SS.Offset(1)).Copy '9行目をコピー
.GetFromClipboard
x = Split(.GetText, vbCrLf) 'xに代入
End With
With CreateObject("Scripting.Dictionary")
For i = 0 To UBound(v) - 1
.Item(v(i)) = .Item(v(i)) + 1 'アイテムのカウント
Next

ReDim myList(1 To .Count, 2)
i = 0
For Each v In .Keys
i = i + 1
myList(i, 0) = v '8行目の値
myList(i, 1) = x '9行目の値を入れたい
myList(i, 2) = .Item(v) '8行目のカウント数
Next

ListBox1.ColumnCount = 3
ListBox1.List = myList()

End With
RR.Worksheet.AutoFilterMode = False
RR.Worksheet.Application.CutCopyMode = False
End Sub

回答No.1

end-u · ベストアンサー

>'8行目の値
>'9行目の値を入れたい
それぞれ、H列、I列、という事ですね。混乱するので行と列の区別はつけましょう。

さて、『ｖの値が重複を除いて、順番にリストに入る動作』という事ですが、
仮に

H列　I列
A　　B
A　　B
A　　C
A　　C

というデータの時は、ListBoxの抽出はどうしますか？
それによって書き方が変わってきます。

パターン１）H列のみ基準。
A　B,C　4

パターン２）H,I列複合基準。
A　B　2
A　C　2

パターン１の場合、DictionaryのItemを配列にする方法が考えられます。
具体的には、
変数
Dim ary As Variant

を追加して

For i = 0 To UBound(v) - 1
　　'H列値が既に登録されていればI列値を","区切りで追加しカウントアップする
　　If .exists(v(i)) Then
　　　　'登録済みのItemの内容を一旦配列に取得
　　　　ary = .Item(v(i))
　　　　'I列値が既に登録されていれば追加はしない
　　　　If InStr(ary(0), x(i)) = 0 Then
　　　　　　ary(0) = ary(0) & "," & x(i)
　　　　End If
　　　　'カウントアップ
　　　　ary(1) = ary(1) + 1
　　　　'追加した配列をItemに戻す
　　　　.Item(v(i)) = ary
　　'H列値が登録されてなければItemに登録
　　Else
　　　　.Item(v(i)) = Array(x(i), 1)
　　End If
Next
ReDim myList(1 To .Count, 2)
i = 0
For Each v In .Keys
　　i = i + 1
　　myList(i, 0) = v　　　　　 'H列の値
　　myList(i, 1) = .Item(v)(0) 'I列の値
　　myList(i, 2) = .Item(v)(1) 'H列値のカウント数
Next

パターン２の場合、DictionaryのKeyをH,I列の複合キーにしてあとで分割します。

Dim ary As Variant

を追加して

Set CC = RR.Columns("H:I")
'：
'省略
'：
Application.Intersect(CC, CC.Offset(1)).Copy 'H,I列をコピー
With New DataObject
　　.GetFromClipboard
　　v = Split(.GetText, vbCrLf) 'vに代入
End With
With CreateObject("Scripting.Dictionary")
　　For i = 0 To UBound(v) - 1
　　　　.Item(v(i)) = .Item(v(i)) + 1
　　Next

　　ReDim myList(1 To .Count, 2)
　　i = 0
　　For Each v In .Keys
　　　　i = i + 1
　　　　'キーをvbTabで分割
　　　　ary = Split(v, vbTab)
　　　　myList(i, 0) = ary(0)　 'H列の値
　　　　myList(i, 1) = ary(1)　 'I列の値
　　　　myList(i, 2) = .Item(v) 'H,I列値のカウント数
　　Next
'：
'省略

その他のアドバイスとして。

ComboBox1_Change イベントは考え直したほうが良いです。
カーソルキーでドロップダウンリストを変更する度にイベントが実行されてしまいます。
_AfterUpdateイベントや_Exitイベント、または他のコントロールのイベントなどが良いでしよう。

また、変数宣言をまとめるなら
Dim i As Long, ii As Long
としないと
>Dim i, ii As Long
これだと i は Variant型で宣言されている事になります。

また、Dictionaryについて理解できない場合、
AdvancedFilterメソッドや関数などを使って、一旦作業用シートにデータを作成し、
そこからListBoxに取り込むようにしても良いかもしれませんね。

補足

end-uさん

ご回答ありがとうございます。
パターン2が私のやりたかったことです。
問題なく動作しました。
本当にありがとうございます。

Dictionaryを理解できれば、いろいろと応用範囲が
広がると思い、日々動作を検証しています。

ちなみに
Set CC = RR.Columns("H:I")を
Set CC = RR.Columns("H:J")にし、

ReDim myList(1 To .Count, 3)
i = 0
　　For Each v In .Keys
　　　　i = i + 1
　　　　'キーをvbTabで分割
　　　　ary = Split(v, vbTab)
　　　　myList(i, 0) = ary(0)　 'H列の値
　　　　myList(i, 1) = ary(1)　 'I列の値
　　　　myList(i, 2) = ary(2)　 'J列の値の合計
　　　　myList(i, 3) = .Item(v) 'H,I列値のカウント数
　　Next
'省略
のようにしたい場合、ary(2)を
下記の場合はカウントですが、
For i = 0 To UBound(v) - 1
　　　　.Item(v(i)) = .Item(v(i)) + 1
Next
値の集計をさせることはできるのでしょうか？
ここまで動作が理解できれば、試してみたいことが
あるので、よろしくお願いします。

回答No.2

end-u

Set CC = RR.Columns("H:I")
Set SS = RR.Columns("J")
...として

'：
Application.Intersect(CC, CC.Offset(1)).Copy
With New DataObject
　　.GetFromClipboard
　　v = Split(.GetText, vbCrLf)
　　Application.Intersect(SS, SS.Offset(1)).Copy
　　.GetFromClipboard
　　x = Split(.GetText, vbCrLf)
End With
With CreateObject("Scripting.Dictionary")
　　For i = 0 To UBound(v) - 1
　　　　If .exists(v(i)) Then
　　　　　　ary = .Item(v(i))
　　　　　　ary(0) = ary(0) + CDbl(x(i))
　　　　　　ary(1) = ary(1) + 1
　　　　　　.Item(v(i)) = ary
　　　　Else
　　　　　　.Item(v(i)) = Array(CDbl(x(i)), 1)
　　　　End If
　　Next
　　ReDim myList(1 To .Count, 3)
　　i = 0
　　For Each v In .Keys
　　　　i = i + 1
　　　　'キーをvbTabで分割
　　　　ary = Split(v, vbTab)
　　　　myList(i, 0) = ary(0)　　　'H列の値
　　　　myList(i, 1) = ary(1)　　　'I列の値
　　　　myList(i, 2) = .Item(v)(0) 'J列の計
　　　　myList(i, 3) = .Item(v)(1) 'H,I列値のカウント数
　　Next
'：
こんな感じでしょうか。
パターン１と２の組み合わせですね。
J列値のエラー対策など、いろいろ工夫してみてください。

"Scripting.Dictionary"の基本についてなら以下参考。
http://msdn.microsoft.com/ja-jp/library/cc428065.aspx
http://www.geocities.jp/cbc_vbnet/Scripting/dictionary.html

では、私はこの辺で。がんばってください。
#今回のケースだと、ピボットテーブルを応用したほうが良さそうな気がしなくもないけど。

お礼

end-uさん

貴重なアドバイスありがとうございました。
いろいろ工夫しながら動作を覚えていきたいと思います。