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

質問です。
前回の質問で説明が不足でしたので再度質問します。
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人となるように
できますか?

●質問者: inosisi
●カテゴリ:コンピュータ インターネット
✍キーワード:不足 山田一郎 山田花子 鈴木 AAA
○ 状態 :終了
└ 回答数 : 4/4件

▽最新の回答へ

1 ● うぃんど
●10ポイント
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
◎質問者からの返答

ありがとうございます

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

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

A12345622222210,000

A1234561111115,000

A1234562222223,000

A1234563333335,000

A1234563333334280005,000

B1233334444443,000

B12333344444410,000

B1233335555552180005,000

C222222666666130003,000

749000


2 ● うぃんど
●10ポイント

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

ありがとうございます。

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

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

他はOKです


3 ● きゃづみぃ
●10ポイント

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

◎質問者からの返答

ありがとうございます

A C D F G

EMTNUO33380853000

EMTNUO33378793000

EMTNUO33386113000

EMTNUO33379013000

EMTNUO333808510000

EMTNUO33380855000

EMTNUO33386113000

EMTNUO33379393000

EMTNUO33378796000

EMTNUO3337879 84900010000

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

よろしくお願いします。


4 ● うぃんど
●60ポイント ベストアンサー

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

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

これで完璧です。

関連質問


●質問をもっと探す●



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