質問です。

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

回答の条件
  • 1人3回まで
  • 13歳以上
  • 登録:2011/03/30 11:43:52
  • 終了:2011/03/30 20:28:52

ベストアンサー

id:taknt No.2

きゃづみぃ回答回数13539ベストアンサー獲得回数11982011/03/30 13:58:50

ポイント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
id:inosisi4141

ありがとうございます。

完璧です。

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

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

2011/03/30 17:11:03

その他の回答(2件)

id:SALINGER No.1

SALINGER回答回数3454ベストアンサー獲得回数9692011/03/30 12:54:13

ポイント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

今までの質問もそうなのですが、この質問・回答へのコメント/トラックバックを表示するにしないとこちらからは返信はできないので、返信を求める場合はオープンしてください。

id:inosisi4141

ありがとうございました。

D列はC列にある数字でおなじものは(たとえばCCCの555のように)1と数え

違うものはその数(AAAの111と222は)2と数えその集計を

D列に集計します。集計の位置はF列と同じ位置です。

2011/03/30 14:48:47
id:taknt No.2

きゃづみぃ回答回数13539ベストアンサー獲得回数11982011/03/30 13:58:50ここでベストアンサー

ポイント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
id:inosisi4141

ありがとうございます。

完璧です。

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

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

2011/03/30 17:11:03
id:SALINGER No.3

SALINGER回答回数3454ベストアンサー獲得回数9692011/03/30 15:49:00

ポイント30pt

私の方の回答は例だと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
id:inosisi4141

質問が悪かったみたいです。

takntさんの解釈でOKです

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

2011/03/30 17:26:22
  • id:taknt
    >「それぞれの箇所に数式をセットしてあげます。」

    集計結果を 値としてセットするのではなく、数式として 「エクセルに計算させる方法をとってます」
    という意味です。
  • id:inosisi4141
    了解しました。
    ありがとうございました。
  • id:taknt
    >修正版をお願いできますか。

    多分、無理でしょう。
  • id:SALINGER
    >多分、無理でしょう。
    へっ?
    そんなに難しく無いですけど。
    必要ないかなと思っていたのですが、それじゃ作りますか。
  • id:SALINGER
    >修正版をお願いできますか。
    どうぞ
    http://d.hatena.ne.jp/SALINGER/20110330

この質問への反応(ブックマークコメント)

トラックバック

  • SALINGERの日記 2011-03-31 01:05:58
    http://q.hatena.ne.jp/1301453031 既に解決しているようなので作らないかなと思っていましたが、 なんか無理とか言ってる人がいたのでさくさくっと作っておきます。 A列が同じ数で並んでいると
「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません