EXCEL VBAでこんな集計できますか？

質問

ECEL　VBAでスプレッドシートの上の行から以上のような数字を入力出来るインターフェースを作りました。（計算後の数字が表記されます）
No 　長さ　　幅　　枚数　←　この項目はEXCEL上に作っておきます。
1 　1200 　　900 　　2
1 　1100 　　450 　　1
1 　1200 　　900 　　1
1 　900 　　500 　　 1
2 　1500 　　900 　　1
2 　900 　　500 　　1
2 　1500 　　900 　　3

この数字を見ますとNo1の中には1200 900 という大きさのものが計３枚
あります。No2にも1500 900が合計４枚あります。これらを下記のように集計できないものでしょうか。
No 　長さ　　　幅　　　枚数　
1 　1200 　　900 　　3
1 　1100 　　450 　　1
1 　　900 　　500 　　1
2 　1500 　　900 　　 4
2 　　900 　　 500 　　 1

また、
No 　　長さ　　　幅　　　枚数　
1 　2 　　1200 　　900 　　 2
1 　3 　　1100 　　450 　　 1
1　 6 　　1200 　　900 　　1
1 　　　　　900 　　500 　　 1
2　 4 　　1500 　 　900 　　 1
2 　　　　　900 　 　500 　 　1
2 　　　　1500 　　900 　　 3
このようにNoが複数になっている場合も上記の集計は出来るでしょうか。（スプレッドシートのNoの列は複数のNoが入るように６つほど空欄で増やしておきます。）
例えば　　1 　 2 　 6 　　　 1200 　　　 900 　　 3 のように
出来ればインターフェース上のコマンドボタンで実行したいと考えています。

回答No.1

e10go · ベストアンサー

A列に「No」、B列に「長さ」、C列に「幅」、D列に「枚数」として、2行～8行にデータがあると仮定して、集計結果をF列2行目以降に書き出すマクロを考えました。
下にマクロコードを載せます。

'－－－－－－－－マクロコード－－－－－－－－始まり
Sub sub_Total_1()
　　Dim i1 As Integer
　　Dim i2 As Integer
　　Dim iRow As Integer
　　Dim iFlag(2 To 8) As Integer
　　iRow = 1
　　For i1 = 2 To 8
　　　　If iFlag(i1) = 0 Then
　　　　　　iRow = iRow + 1
　　　　　　Cells(iRow, "F") = Cells(i1, "A")
　　　　　　Cells(iRow, "G") = Cells(i1, "B")
　　　　　　Cells(iRow, "H") = Cells(i1, "C")
　　　　　　Cells(iRow, "I") = Cells(i1, "D")
　　　　　　For i2 = i1 + 1 To 8
　　　　　　　　If Cells(i1, "A") & Cells(i1, "B") & Cells(i1, "C") = _
　　　　　　　　　　Cells(i2, "A") & Cells(i2, "B") & Cells(i2, "C") Then
　　　　　　　　　　Cells(iRow, "I") = Cells(iRow, "I") + Cells(i2, "D")
　　　　　　　　　　iFlag(i2) = 1
　　　　　　　　End If
　　　　　　Next i2
　　　　End If
　　Next i1
End Sub
'－－－－－－－－マクロコード－－－－－－－－終わり

>このようにNoが複数になっている場合も上記の集計は出来るでしょうか。（スプレッドシートのNoの列は複数のNoが入るように６つほど空欄で増やしておきます。）
>例えば　　1 　 2 　 6 　　　 1200 　　　 900 　　 3 のように

これは、難しい注文ですね(笑)。
「長さ」と「幅」が同じで、「No」が1つでも同じ物があれば集計する、と言う条件でしょうか？。
一応、考えてみましたが、少し複雑になりました。
とりあえず「No」はA列～F列(6列)で、K列2行目から書き出す様にしています。

'－－－－－－－－マクロコード－－－－－－－－始まり
Sub sub_Total_2()
　　Dim i1 As Integer
　　Dim i2 As Integer
　　Dim i3 As Integer
　　Dim i4 As Integer
　　Dim iRow As Integer
　　Dim iColumn As Integer
　　Dim iFlag(2 To 8) As Integer
　　iRow = 1
　　For i1 = 2 To 8
　　　　If iFlag(i1) = 0 Then
　　　　　　iRow = iRow + 1
　　　　　　iColumn = 10
　　　　　　For i2 = 1 To 6
　　　　　　　　If Cells(i1, i2) <> "" Then
　　　　　　　　　　iColumn = iColumn + 1
　　　　　　　　　　Cells(iRow, iColumn) = Cells(i1, i2)
　　　　　　　　End If
　　　　　　Next i2
　　　　　　For i2 = 7 To 9
　　　　　　　　Cells(iRow, 10 + i2) = Cells(i1, i2)
　　　　　　Next i2
　　　　　　For i2 = i1 + 1 To 8
　　　　　　　　If iFlag(i1) = 0 _
　　　　　　　　And Cells(i1, "G") & Cells(i1, "H") = Cells(i2, "G") & Cells(i2, "H") Then
　　　　　　　　　　For i3 = 1 To 6
　　　　　　　　　　　　If Application.CountIf(Range("A" & i2 & ":F" & i2), Cells(i1, i3)) > 0 Then
　　　　　　　　　　　　　　Cells(iRow, "S") = Cells(iRow, "S") + Cells(i2, "I")
　　　　　　　　　　　　　　For i4 = 1 To 6
　　　　　　　　　　　　　　　　If Application.CountIf(Range("A" & i1 & ":F" & i1), Cells(i2, i4)) = 0 _
　　　　　　　　　　　　　　　　And Cells(i2, i4) <> "" Then
　　　　　　　　　　　　　　　　　　iColumn = iColumn + 1
　　　　　　　　　　　　　　　　　　Cells(iRow, iColumn) = Cells(i2, i4)
　　　　　　　　　　　　　　　　End If
　　　　　　　　　　　　　　Next i4
　　　　　　　　　　　　　　iFlag(i2) = 1
　　　　　　　　　　　　　　Exit For
　　　　　　　　　　　　End If
　　　　　　　　　　Next i3
　　　　　　　　End If
　　　　　　Next i2
　　　　End If
　　Next i1
End Sub
'－－－－－－－－マクロコード－－－－－－－－終わり

もし、集計条件が間違っていましたら、すみません。

>出来ればインターフェース上のコマンドボタンで実行したいと考えています。

これは、質問者さんの方でマクロとコマンドボタンの関連付けはできますよね。

＃この回答に載せているそれぞれのコードの先頭の空白は、全角にしています。
＃もし、コピーして使用される場合は、全角空白を半角に直してください。

補足

長文の回答、ありがとうございます。
早速やってみました。残念ながら下記のようになってしまいます。
1 　1200 　　　900 　　　2
1 　1100 　　　450 　　　1
本当は下記のようにしたいのですが
1 　1200 　　900 　　3
1 　1100 　　450 　　1
1 　　900 　　500 　　1
2 　1500 　　900 　　 4
2 　　900 　　 500 　　 1
Noと枚数が違います。枚数は個数の抽出ではなくて足し算になると思うのですが。もう一つの回答もうまくいきませんでした。　　う～ん、でも解決の糸口が見えてきたような。なんとか出来そうな気がしてきました。

回答No.3

e10go

こんばんわ。No.1のe10goです。

何度もすみませんが、A2～C2セル(1,1200,900)をコピーして、A4～C4セルに貼り付けて、再度、マクロを実行しても同じでしょうか。

お礼

出来ました！2つ目の回答もばっちりです。感謝します。
行数の変更を試行錯誤しながらやってみました。まだ、コードの解釈が完全ではありませんが使えます。すごいですね！今までこのような集計はEXCELでは不可能だと思っていました。コマンドボタン一発で出来ます。もうちょっと行数を増やしてトライしてみます。ありがとうございました。

回答No.2

e10go

こんばんわ。No.1のe10goです。

>早速やってみました。残念ながら下記のようになってしまいます。
>1 　1200 　　　900 　　　2
>1 　1100 　　　450 　　　1

おかしいな。どうしてでしょう？
私のパソコンでは、上のコードで、

(行),F列,G列,H列,I列
(2),1,1200,900,3
(3),1,1100,450,1
(4),1,900,500,1
(5),2,1500,900,4
(6),2,900,500,1

となりましたが？

データは、

(行),A列,B列,C列,D列
(1),No,長さ,幅,枚数
(2),1,1200,900,2
(3),1,1100,450,1
(4),1,1200,900,1
(5),1,900,500,1
(6),2,1500,900,1
(7),2,900,500,1
(8),2,1500,900,3

ですよね。

どこに問題あるんだろう？
ちょうっと、私にはわかりません。申し訳ありません。

補足

申し訳ありません。
私が自分の作ったEXCELの表でそのままVB　Editerにコードを入れてしまったためです。実は私の表は7番目の行から数字が入ります。それから上は項目などの表の体裁です。あなたが書いてくれたコードは2行目からですよね。最初の答えはばっちり出来ました。現在、2つ目の回答のコードを解釈して行数の変更をしているところです。ありがとうございます。