クロス集計で商品名かつサイズかつ地区で表示させるには

いつもお世話になっております。
以下のｺｰﾄﾞに条件つけたのですが、
おしえてくれませんでしょうか

めぐみん様
Ｆ列に商品　G列にサイズ　Ｈ列に地区
おしえてくれませんでしょうか

この質問はこれで最後に致します。
お願いします。


今は　表示されているのはサイズと商品のみです。


Sub megu()

Dim myDic As Object
Dim r As Range, m As Long
Dim key As Variant, v As Variant
Set myDic = CreateObject("Scripting.Dictionary")

For Each r In Range("a2", Cells(Rows.Count, "a").End(xlUp))
key = r.Value & "_" & r.Offset(, 1).Value

If Not myDic.Exists(key) Then _
myDic.Add key, Range("f1:AG1").Value

m = IIf(Month(r.Offset(, 2).Value) < 4, _
Month(r.Offset(, 2).Value) + 9, Month(r.Offset(, 2).Value) - 3)

m = m * 2 '求められた結果を仕様により上書きする場合の書き方

v = myDic(key) '★ここを忘れてました★

v(1, m - 1) = v(1, m - 1) + 1 '無条件にカウントを取る場合（各月の奇数列）
v(1, m) = v(1, m) + r.Offset(, 3).Value '条件によってカウントを取る場合（各月の偶数列）

myDic(key) = v
'Debug.Print r.Value, myDic(r.Value)(1, m)

Next

Set rr = Range("F3")
For Each key In myDic.keys
rr.Offset(, 1).Resize(, 3) = Split(key, "_")

rr.Offset(, 3).Resize(, 24).Value = myDic(key)
Set rr = rr.Offset(1)
Next

Set myDic = Nothing
Set r = Nothing

No.1 ベストアンサー 回答者： めぐみん_ 回答日時： 2020/09/17 05:49

For Each r In Range("a2", Cells(Rows.Count, "a").End(xlUp))

key = r.Value & "_" & r.Offset(, 1).Value

↓

For Each r In Range("a2", Cells(Rows.Count, "a").End(xlUp))
key = r.Offset(, 1).Value & "_" & r.Value & "_" & r.Offset(, 4).Value



Set rr = Range("F3")
For Each key In myDic.keys
rr.Offset(, 1).Resize(, 3) = Split(key, "_")

↓

Set rr = Range("F3")
For Each key In myDic.keys
rr.Resize(, 3).Value = Split(key, "_")

でしょうか？

この回答へのお礼

いつも有難うございます。
うまくいきました。
じつをいいますと、
key = r.Offset(, 1).Value & "_" & r.Value & "_" & r.Offset(, 4).Value
なんとなく、いくのかなと質問する前にやってみました。
rr.Resize(, 3)も同じです。がわたしがやったら
だめでした。
おそらく、やっているうちにいつものパターンで
頭がぐちゃぐちゃになっていたのかもしれません。
ありがとうございました

お礼日時：2020/09/17 07:57