人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

質問です。
A列 C列 D列 F列 G列
AAA 111 5000
AAA 222 5000
CCC 555 3000
CCC 555 5000
上記の集計結果が
A列のグループ毎に最下位のF列に小計する
C列の同じ数字は一つで判断する
列 C列 D列 F列 G列
AAA 222 2 10000 5000
CCC 555 1 8000 5000

●質問者: inosisi
●カテゴリ:コンピュータ インターネット
✍キーワード:555 グループ 数字 最下位 AAA
○ 状態 :終了
└ 回答数 : 3/3件

▽最新の回答へ

1 ● SALINGER
●10ポイント

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列と同じ位置です。


2 ● きゃづみぃ
●55ポイント ベストアンサー

マクロを実行して それぞれの箇所に数式をセットしてあげます。

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
◎質問者からの返答

ありがとうございます。

完璧です。

「それぞれの箇所に数式をセットしてあげます。」

の意味はどういうことでしょうか?


3 ● SALINGER
●30ポイント

私の方の回答は例だと4行が集計されて最下行だけを残して2行になるものです。

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さんの解釈でOKです

修正版をお願いできますか。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ