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

いつもお世話になっております。
めぐみん様
下記の書き出しのコードで
教えていただきたいことがあります。

付け加えた部分です。

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

v(1, m) = v(1, m) + WorksheetFunction.Sum(r.Offset(, 3))　

rr.Offset(, 1).Resize(, 2) = Split(key, "_")

添付ファイルの黄色反転致しました
合計と個数がうまくされません。
おしえてくれませんでしょうか


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) + WorksheetFunction.Sum(r.Offset(, 3))

myDic(key) = v

End If
Next

Set rr = Range("F3")

For Each key In myDic.keys
rr.Offset(, 1).Resize(, 2) = Split(key, "_")

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

質問者からの補足コメント

• 

  うれしいです
  うまくできました。
  ありがとうございました。
  お体大切に

  No.4の回答に寄せられた補足コメントです。 補足日時：2020/12/23 08:51

No.4 ベストアンサー 回答者： めぐみん_ 回答日時： 2020/12/23 06:49

あ～。

やっぱ実際に検証しないと初級レベルでは解決できないなんて・・・
⇒と言っても検証してないのですが・・・

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 _ ' "_" にてIf文は１行に纏める
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) = Val(v(1, m - 1)) + 1 '念のため数値化変換
v(1, m) = Val(v(1, m)) + r.Offset(, 3).Value

myDic(key) = v

'End If '上で１行にしているので不要
Next

Set rr = Range("F3")

For Each key In myDic.keys
rr.Offset(, 1).Resize(, 2) = Split(key, "_")

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

この回答へのお礼

いつもお世話になっております。
と初級レベルでは　めぐみん様はちがいます
この頃いろんなサイト拝見して
おもったこと。
めぐみん様のコードわかりやすいんです。
ありがとうございました。
いまから、試します。

System.Collections.ArrayListで
解決しているのですが
なんとなく、これでもいけるのかな
と思いやってみました。

お礼日時：2020/12/23 08:40

No.3 回答者： めぐみん_ 回答日時： 2020/12/23 00:02

あ”””””””””。

更にミスった。

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

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

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

v = myDic(key)

v(1, m - 1) = 1
v(1, m) = r.Offset(, 3).Value

myDic(key) = v

Else 'key の重複の有無で処理が変わりますが、片方が漏れてたからでは？

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

End If
Next

こうかな？

No.2 回答者： めぐみん_ 回答日時： 2020/12/22 23:51

あ”。

違ったかな？

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

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

If Not myDic.Exists(key) Then
myDic.Add key, Range("F1:AG1").Value
v(1, m - 1) = 1
v(1, m) = r.Offset(, 3).Value

Else 'key の重複の有無で処理が変わりますが、片方が漏れてたからでは？

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

End If
Next

この回答へのお礼

ありがとうございます。

お礼日時：2020/12/23 08:34

No.1 回答者： めぐみん_ 回答日時： 2020/12/22 23:45

救急外来から帰ってきたとこなのでボケてるかもですが。

＞v(1, m) = v(1, m) + WorksheetFunction.Sum(r.Offset(, 3))

私このコードって書いた事ありましたっけ？
セル範囲が１つなのにＳＵＭ関数を用いるって・・・その時もボケてた？

過去の質問の修正を上げるのであればその時の質問のリンクを貼ってもらえると助かります。

普通に考えられるのはＳＵＭ関数は不要で、

v(1, m) = v(1, m) + r.Offset(, 3).Value

になると思われるのですが・・・？

この回答へのお礼

いつもお世話になっております。

最初　ご教授頂いたのは
v(1, m) = v(1, m) + r.Offset(, 3).Value
でした。

いじくりまわして、sumになっていました。
お体大丈夫でしようか。
お大事にしてください。

お礼日時：2020/12/23 08:33