Ａ列 Ｃ列 Ｄ列 Ｆ列 Ｇ列
ＡＡＡ 111 5000
ＡＡＡ 222 5000
ＣＣＣ 555 3000
ＣＣＣ 555 5000
上記の集計結果が
Ａ列のグループ毎に最下位のＦ列に小計する
Ｃ列の同じ数字は一つで判断する
列 Ｃ列 Ｄ列 Ｆ列 Ｇ列
ＡＡＡ 222 2 10000 5000
ＣＣＣ 555 1 8000 5000
No.2
13539
1198
55pt
マクロを実行して それぞれの箇所に数式をセットしてあげます。
Sub 集計() a = 1 c = Cells(1, 1) For b = 1 To 65536 If c <> Cells(b, 1) Then Cells(b - 1, "D").Formula = "=SUMPRODUCT(1/COUNTIF(C" & a & ":C" & b - 1 & ",C" & a & ":C" & b - 1 & "))" Cells(b - 1, "F").Formula = "=SUM(G" & a & ":G" & b - 1 & ")" a = b End If c = Cells(b, 1) If Cells(b, 1) = "" Then Exit For Next b End Sub
No.1
3454969
10pt
D列については何も書いていないので、省いています。
集計が必要な場合は修正します。
Sub Macro() Application.ScreenUpdating = False Dim i As Long Dim j As Long Dim lastRow As Long lastRow = Cells(Rows.Count, "A").End(xlUp).Row Range("G:G").Copy Range("F:F") For i = 1 To lastRow For j = i + 1 To lastRow If Cells(i, "A").Value = Cells(j, "A").Value Then Cells(j, "F").Value = Cells(j, "F").Value + Cells(i, "F").Value Rows(i).Delete i = i - 1 lastRow = lastRow - 1 Exit For End If Next j Next i Application.ScreenUpdating = True End Sub
今までの質問もそうなのですが、この質問・回答へのコメント/トラックバックを表示するにしないとこちらからは返信はできないので、返信を求める場合はオープンしてください。
ありがとうございました。
D列はC列にある数字でおなじものは（たとえばCCCの555のように）1と数え
違うものはその数（AAAの111と222は）2と数えその集計を
D列に集計します。集計の位置はF列と同じ位置です。
No.2
135391198
ここでベストアンサー
55pt
マクロを実行して それぞれの箇所に数式をセットしてあげます。
Sub 集計() a = 1 c = Cells(1, 1) For b = 1 To 65536 If c <> Cells(b, 1) Then Cells(b - 1, "D").Formula = "=SUMPRODUCT(1/COUNTIF(C" & a & ":C" & b - 1 & ",C" & a & ":C" & b - 1 & "))" Cells(b - 1, "F").Formula = "=SUM(G" & a & ":G" & b - 1 & ")" a = b End If c = Cells(b, 1) If Cells(b, 1) = "" Then Exit For Next b End Sub
ありがとうございます。
完璧です。
「それぞれの箇所に数式をセットしてあげます。」
の意味はどういうことでしょうか？
No.3
3454969
30pt
私の方の回答は例だと４行が集計されて最下行だけを残して２行になるものです。
takntさんの方はそのまま最下行に数式を入れて集計するものです。D列の解釈も意図するものなので、
takntさんの方の解釈があっているならば蛇足となりますが、とりあえず私の回答にD列を追加したものです。
Sub Macro2() Application.ScreenUpdating = False Dim i As Long Dim j As Long Dim lastRow As Long lastRow = Cells(Rows.Count, "A").End(xlUp).Row Range("G:G").Copy Range("F:F") For i = 1 To lastRow For j = i + 1 To lastRow If Cells(i, "A").Value = Cells(j, "A").Value And _ Cells(i, "C").Value = Cells(j, "C").Value Then Cells(j, "F").Value = Cells(j, "F").Value + Cells(i, "F").Value Rows(i).Delete i = i - 1 lastRow = lastRow - 1 Exit For End If Next j Next i lastRow = Cells(Rows.Count, "A").End(xlUp).Row Range(Cells(1, "D"), Cells(lastRow, "D")).Value = 1 For i = 1 To lastRow For j = i + 1 To lastRow If Cells(i, "A").Value = Cells(j, "A").Value Then Cells(j, "F").Value = Cells(j, "F").Value + Cells(i, "F").Value Cells(j, "D").Value = Cells(j, "D").Value + 1 Rows(i).Delete i = i - 1 lastRow = lastRow - 1 Exit For End If Next j Next i Application.ScreenUpdating = True End Sub
質問が悪かったみたいです。
takntさんの解釈でＯＫです
修正版をお願いできますか。
きゃづみぃ
2011/03/30 17:22:22
1
2
2
1
1
5
146
144
inosisi
SALINGER
ありがとうございます。
完璧です。
「それぞれの箇所に数式をセットしてあげます。」
の意味はどういうことでしょうか？