コード別に性別ごとに金額と件数を小計するマクロをお願いします
B列にコード(半角英数小文字)C列に男女、I列に金額のエクセルデータがあります
データは2行目から
B列 C列 I列
コード 性別 金額
aaaa 男 -1000
aaaa 男 -2000
bbbb 女 -1000
abcd 女 -1000
答え
2行目からデータ
同じコードの最後の行に答えの小計をだす
D列(男の金額)E列(男の数)F列(女の金額)G列(女の数)
A列にはB列とおなじコードを表示
A列 B列 C列 D列 E列 F列 G列 I列
男の金額と数 女の金額と数
aaaa 男 -1000
aaaa aaaa 男 -3000 2 -2000
bbbb bbbb 女 -1000 1 -1000
abcd abcd 女 -1000 1 -1000
Sub main() 'コードでソートされているのを条件として実行します。 '1行もないとき If Cells(2, "B") = "" Then Exit Sub End If '初期値のセット c1 = Cells(2, "B") c2 = Cells(2, "C") If c2 = "男" Then d1 = Cells(2, "I") e1 = 1 Else d2 = Cells(2, "I") e2 = 1 End If '1行しかないとき If Cells(3, "B") = "" Then Cells(2, "A") = Cells(2, "B") If c2 = "男" Then Cells(2, "D") = d1 Cells(2, "E") = e1 Else Cells(2, "F") = d2 Cells(2, "G") = e2 End If Exit Sub End If d1 = 0 d2 = 0 e1 = 0 e2 = 0 For a = 2 To Cells(2, "B").End(xlDown).Row If Cells(a, "B") <> c1 Then Cells(a - 1, "A") = Cells(a - 1, "B") If e1 > 0 Then Cells(a - 1, "D") = d1 Cells(a - 1, "E") = e1 End If If e2 > 0 Then Cells(a - 1, "F") = d2 Cells(a - 1, "G") = e2 End If d1 = 0 d2 = 0 e1 = 0 e2 = 0 End If c1 = Cells(a, "B") If Cells(a, "C") = "男" Then d1 = Cells(a, "I") + d1 e1 = e1 + 1 Else d2 = Cells(a, "I") + d2 e2 = e2 + 1 End If Next a Cells(a - 1, "A") = Cells(a - 1, "B") If e1 > 0 Then Cells(a - 1, "D") = d1 Cells(a - 1, "E") = e1 End If If e2 > 0 Then Cells(a - 1, "F") = d2 Cells(a - 1, "G") = e2 End If End Sub
ありがとうございます。
結論的にはOKですが男の数が1件どうしても合いません
答えの男の数が1件多いみたいです。
金額は合っています。
よろしくお願いします。