質問です。

前回の質問で説明が不足でしたので再度質問します。
A列    C列   D列  F列    G列  
AAAA  山田一郎           5000
AAAA  山田一郎           5000
AAAA  鈴木太郎           3000
AAAA  鈴木太郎           3000
AAAA  山木一太  3  26000   10000 
BBBB  山田花子           5000
BBBB  いとうしろう         3000
BBBB  いとうしろう 2  11000   3000
CCCC  あかさたな  1  10000  10000 
      
       計     6人 47000円

上記のようにC列の数は同じ人は1と数えてD列に上から計3人、
2人、1人となるように
できますか?

回答の条件
  • 1人3回まで
  • 13歳以上
  • 登録:2011/03/31 19:00:30
  • 終了:2011/04/02 13:13:27

ベストアンサー

id:windofjuly No.4

うぃんど回答回数2625ベストアンサー獲得回数11492011/04/02 12:59:47

ポイント60pt

3度目失礼

合計ならびに列の訂正バージョン

Sub Macro3()
    '準備
    Dim lastRow As Long
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row: 'A列を見てデータの最終行を求める
    If lastRow = 1 Then Exit Sub: 'A列にデータが無ければ何もせずプログラムはココで終了
    
    '初期設定
    Dim startRow As Long: '開始行(初期値は1行目にしてあります)
    Dim groupStartRow As Long: 'グループの開始行(初期値はstartRowです)
    Dim sum1 As Long: ' 人数集計用(初期値はゼロです)
    Dim sum2 As Long: ' 金額集計用(初期値はゼロです)
    Dim nowRow As Long: '作業中の行(ループで使用するため初期値ありません)
    Dim nextRow As Long: '次の行(ループ中に計算で求めるため初期値ありません)
    startRow = 1
    sum1 = 0
    sum2 = 0
    
    'ゼロクリア(D列F列をクリア)
    Range("D" & startRow & ":D" & lastRow + 1 & ",F" & startRow & ":F" & lastRow + 1).Value = ""
    
    'グループ毎の集計作業
    groupStartRow = startRow
    For nowRow = groupStartRow To lastRow
        nextRow = nowRow + 1
        If Evaluate("SUMPRODUCT((A" & groupStartRow & ":A" & nowRow & "=A" & nowRow & ")*(C" & groupStartRow & ":C" & nowRow & "=C" & nowRow & "))") = 1 Then
            'A列が同じ範囲でC列が既出でなければ人数加算
            sum1 = sum1 + 1
        End If
        sum2 = sum2 + Range("G" & nowRow).Value: '金額加算
        If Range("A" & nowRow).Value <> Range("A" & nextRow).Value Then
            '次の行とA列が違えば人数と合計を書き込んで集計用変数はゼロに戻す
            Range("D" & nowRow).Value = sum1
            Range("F" & nowRow).Value = sum2
            sum1 = 0
            sum2 = 0
            groupStartRow = nextRow
        End If
    Next nowRow
    
    '全体集計作業(合計の算出と書き込み)
    Range("D" & lastRow + 1).Value = Application.WorksheetFunction.Sum(Range("D" & startRow & ":D" & lastRow))
    Range("F" & lastRow + 1).Value = Application.WorksheetFunction.Sum(Range("F" & startRow & ":F" & lastRow))
End Sub
id:inosisi4141

いろいろご無理申し上げましてありがとうございました。

これで完璧です。

2011/04/02 13:11:47

その他の回答(3件)

id:windofjuly No.1

うぃんど回答回数2625ベストアンサー獲得回数11492011/03/31 20:12:36

ポイント10pt
Sub Macro()
    '調査
    Dim lastRow As Long
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row: 'A列を見てデータの最終行を求める
    If lastRow = 1 Then Exit Sub: 'A列にデータが無ければ何もせずプログラムはココで終了
    
    '初期設定
    Dim startRow As Long: '開始行(初期値は1行目にしてあります)
    Dim sum1 As Long: ' 人数集計用(初期値はゼロです)
    Dim sum2 As Long: ' 金額集計用(初期値はゼロです)
    Dim nowRow As Long: '作業中の行(ループで使用するため初期値ありません)
    Dim nextRow As Long: '次の行(ループ中に計算で求めるため初期値ありません)
    startRow = 1
    sum1 = 0
    sum2 = 0
    
    'C列D列をクリア
    Range("C" & startRow & ":D" & lastRow + 1).Value = ""
    
    'グループ毎の集計作業
    For nowRow = startRow To lastRow
        nextRow = nowRow + 1
        If Range("A" & nowRow).Value <> Range("A" & nextRow).Value Then
            '次の行とA列が違えば人数と金額加算後の合計を書き込んで集計用変数はゼロに戻す
            Range("c" & nowRow).Value = sum1 + 1
            Range("d" & nowRow).Value = sum2 + Range("E" & nowRow).Value
            sum1 = 0
            sum2 = 0
        Else
            'A列が同じであれば金額加算
            sum2 = sum2 + Range("E" & nowRow).Value
            If Range("B" & nowRow).Value <> Range("B" & nextRow).Value Then
                'B列が違う場合は人数も加算
                sum1 = sum1 + 1
            End If
        End If
    Next nowRow
    
    '全体集計作業(合計の算出と書き込み)
    Range("C" & lastRow + 1).Value = Application.WorksheetFunction.Sum(Range("C" & startRow & ":C" & lastRow))
    Range("D" & lastRow + 1).Value = Application.WorksheetFunction.Sum(Range("D" & startRow & ":D" & lastRow))
End Sub
id:inosisi4141

ありがとうございます

下記のような間に111111が入っている場合があります

実際は結果は3になるようにできますか?

A123456 222222 10,000

A123456 111111 5,000

A123456 222222 3,000

A123456 333333 5,000

A123456 333333 4 28000 5,000

B123333 444444 3,000

B123333 444444 10,000

B123333 555555 2 18000 5,000

C222222 666666 1 3000 3,000

7 49000

2011/03/31 23:04:54
id:windofjuly No.2

うぃんど回答回数2625ベストアンサー獲得回数11492011/04/01 00:05:08

ポイント10pt

回答1の改造部分のみ記載しています

    'グループ毎の集計作業
    For nowRow = startRow To lastRow
        nextRow = nowRow + 1
        If Evaluate("SUMPRODUCT((A" & startRow & ":A" & nowRow & "=A" & nowRow & ")*(B" & startRow & ":B" & nowRow & "=B" & nowRow & "))") = 1 Then
            'A列が同じ範囲でB列が既出でなければ人数加算
            sum1 = sum1 + 1
        End If
        sum2 = sum2 + Range("E" & nowRow).Value: '金額加算
        If Range("A" & nowRow).Value <> Range("A" & nextRow).Value Then
            '次の行とA列が違えば人数と合計を書き込んで集計用変数はゼロに戻す
            Range("c" & nowRow).Value = sum1
            Range("d" & nowRow).Value = sum2
            sum1 = 0
            sum2 = 0
            startRow = nextRow
        End If
    Next nowRow
id:inosisi4141

ありがとうございます。

最終行にC列D列の集計結果らしきものがでていますが

合計されていませんC列D列の合計はだせますか。

他はOKです

2011/04/02 12:32:39
id:taknt No.3

きゃづみぃ回答回数13539ベストアンサー獲得回数11982011/03/31 22:56:32

ポイント10pt

windofjulyさんは 列を間違えてるので 残念ながら そのまま 使えません。

せっかくなので 修正しました。

Sub Macro()
    '調査
    Dim lastRow As Long
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row: 'A列を見てデータの最終行を求める
    If lastRow = 1 Then Exit Sub: 'A列にデータが無ければ何もせずプログラムはココで終了
    
    '初期設定
    Dim startRow As Long: '開始行(初期値は1行目にしてあります)
    Dim sum1 As Long: ' 人数集計用(初期値はゼロです)
    Dim sum2 As Long: ' 金額集計用(初期値はゼロです)
    Dim nowRow As Long: '作業中の行(ループで使用するため初期値ありません)
    Dim nextRow As Long: '次の行(ループ中に計算で求めるため初期値ありません)
    startRow = 1
    sum1 = 0
    sum2 = 0
    
    'D列F列をクリア
    Range("D" & startRow & ":D" & lastRow + 1).Value = ""
    Range("F" & startRow & ":F" & lastRow + 1).Value = ""
    
    'グループ毎の集計作業
    For nowRow = startRow To lastRow
        nextRow = nowRow + 1
        If Range("A" & nowRow).Value <> Range("A" & nextRow).Value Then
            '次の行とA列が違えば人数と金額加算後の合計を書き込んで集計用変数はゼロに戻す
            Range("D" & nowRow).Value = sum1 + 1
            Range("F" & nowRow).Value = sum2 + Range("G" & nowRow).Value
            sum1 = 0
            sum2 = 0
        Else
            'A列が同じであれば金額加算
            sum2 = sum2 + Range("G" & nowRow).Value
            If Range("C" & nowRow).Value <> Range("C" & nextRow).Value Then
                'B列が違う場合は人数も加算
                sum1 = sum1 + 1
            End If
        End If
    Next nowRow
    
    '全体集計作業(合計の算出と書き込み)
    Range("D" & lastRow + 1).Value = Application.WorksheetFunction.Sum(Range("D" & startRow & ":D" & lastRow))
    Range("F" & lastRow + 1).Value = Application.WorksheetFunction.Sum(Range("F" & startRow & ":F" & lastRow))
End Sub

id:inosisi4141

ありがとうございます

 A         C     D       F    G

EMTNUO 3338085 3000

EMTNUO 3337879 3000

EMTNUO 3338611 3000

EMTNUO 3337901 3000

EMTNUO 3338085 10000

EMTNUO 3338085 5000

EMTNUO 3338611 3000

EMTNUO 3337939 3000

EMTNUO 3337879 6000

EMTNUO 3337879   8 49000 10000

実際は8 → 5 になればよいのですが

よろしくお願いします。

2011/04/02 10:15:38
id:windofjuly No.4

うぃんど回答回数2625ベストアンサー獲得回数11492011/04/02 12:59:47ここでベストアンサー

ポイント60pt

3度目失礼

合計ならびに列の訂正バージョン

Sub Macro3()
    '準備
    Dim lastRow As Long
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row: 'A列を見てデータの最終行を求める
    If lastRow = 1 Then Exit Sub: 'A列にデータが無ければ何もせずプログラムはココで終了
    
    '初期設定
    Dim startRow As Long: '開始行(初期値は1行目にしてあります)
    Dim groupStartRow As Long: 'グループの開始行(初期値はstartRowです)
    Dim sum1 As Long: ' 人数集計用(初期値はゼロです)
    Dim sum2 As Long: ' 金額集計用(初期値はゼロです)
    Dim nowRow As Long: '作業中の行(ループで使用するため初期値ありません)
    Dim nextRow As Long: '次の行(ループ中に計算で求めるため初期値ありません)
    startRow = 1
    sum1 = 0
    sum2 = 0
    
    'ゼロクリア(D列F列をクリア)
    Range("D" & startRow & ":D" & lastRow + 1 & ",F" & startRow & ":F" & lastRow + 1).Value = ""
    
    'グループ毎の集計作業
    groupStartRow = startRow
    For nowRow = groupStartRow To lastRow
        nextRow = nowRow + 1
        If Evaluate("SUMPRODUCT((A" & groupStartRow & ":A" & nowRow & "=A" & nowRow & ")*(C" & groupStartRow & ":C" & nowRow & "=C" & nowRow & "))") = 1 Then
            'A列が同じ範囲でC列が既出でなければ人数加算
            sum1 = sum1 + 1
        End If
        sum2 = sum2 + Range("G" & nowRow).Value: '金額加算
        If Range("A" & nowRow).Value <> Range("A" & nextRow).Value Then
            '次の行とA列が違えば人数と合計を書き込んで集計用変数はゼロに戻す
            Range("D" & nowRow).Value = sum1
            Range("F" & nowRow).Value = sum2
            sum1 = 0
            sum2 = 0
            groupStartRow = nextRow
        End If
    Next nowRow
    
    '全体集計作業(合計の算出と書き込み)
    Range("D" & lastRow + 1).Value = Application.WorksheetFunction.Sum(Range("D" & startRow & ":D" & lastRow))
    Range("F" & lastRow + 1).Value = Application.WorksheetFunction.Sum(Range("F" & startRow & ":F" & lastRow))
End Sub
id:inosisi4141

いろいろご無理申し上げましてありがとうございました。

これで完璧です。

2011/04/02 13:11:47

コメントはまだありません

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

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

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

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