こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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

投稿日時 - 2018-03-28 17:17:26

QNo.9482700

困ってます

質問者が選んだベストアンサー

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

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

投稿日時 - 2018-03-28 20:28:52

お礼

HohoPapa様

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

投稿日時 - 2018-03-29 10:57:18

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(2)

ANo.2

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

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

投稿日時 - 2018-03-29 10:55:02

お礼

Chiquilin様

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

投稿日時 - 2018-03-29 15:06:46

あなたにオススメの質問