VBA 複数のシートをまたいでの連想配列

質問

win7、Excelは2013を使用しています。

添付画像の様に、12シートの合計を連想配列に格納しsheet13に書き出したいのですが、プロシージャーの下から6行目のところで、エラーコード451が出ます。
どの様に変更すれば良いか教えて下さい。

Sub 年間集計()
Dim Dic
Dim i As Integer
Dim j As Integer
Dim sh As Worksheet
Dim rng As Range
Dim buf As String
Dim num As Integer

Set Dic = CreateObject("Scripting.Dictionary")

For Each sh In Worksheets
For Each rng In sh.Range("J2", sh.Cells(Rows.Count, 10).End(xlUp))
buf = rng.Value
num = rng.Offset(, 1).Value
If Not Dic.Exists(buf) Then
Dic.Add buf, num
Else
Dic.Item(buf) = Dic.Item(buf) + num
End If
Next rng
Next sh

j = 2
With Worksheets("Sheet13")
For i = 0 To Dic.Count - 1
.Cells(j, 1) = Dic.Keys(i)　　　’エラー箇所
.Cells(j, 2) = Dic.Items(i)
j = j + 1
Next i
End With
End Sub

回答No.1

HohoPapa · ベストアンサー

こんなカンジでしょうか。

Sub 年間集計()
　Dim Dic
　Dim i As Integer
　Dim j As Integer
　Dim sh As Worksheet
　Dim rng As Range
　Dim buf As String
　Dim num As Integer
　Dim Keys() As Variant

　Set Dic = CreateObject("Scripting.Dictionary")

　For Each sh In Worksheets
　　For Each rng In sh.Range("J2", sh.Cells(Rows.Count, 10).End(xlUp))
　　　buf = rng.Value
　　　num = rng.Offset(, 1).Value
　　　If Not Dic.Exists(buf) Then
　　　　Dic.Add buf, num
　　　Else
　　　　Dic.Item(buf) = Dic.Item(buf) + num
　　　End If
　　Next rng
　Next sh

　j = 2
　Keys = Dic.Keys
　With Worksheets("Sheet13")
　　For i = 0 To Dic.Count - 1
　　 .Cells(j, 1) = Keys(i)　　　'エラー箇所
　　 .Cells(j, 2) = Dic.Item(Keys(i))
　　　j = j + 1
　　Next i
　End With
End Sub

お礼

HohoPapa様

エラーにならずに、書き出しまで出来ました。
変数にすると出来る様になるんですね。
そこのところが理解出来ていないので、勉強します。
ありがとうございました。

回答No.2

Chiquilin

Excel2013なら連想配列なんて使わなくても データを一か所
に集めてから RemoveDuplicatesメソッドを使えばおしまい
だと思います。

重複した値を削除　RemoveDuplicatesメソッド - Excel VBA他サンプル等
https://excwlvba.blogspot.jp/2013/06/removeduplicates.html

お礼

Chiquilin様

今回は、連想配列でいたかったので、連想配列のままで行きますが、
ご回答いただいた内容を勉強させて頂き、次回に活かしたいと思います。
ありがとうございました。