エクセルvbaで、同じ番号の請求書の金額をまとめる方法を教えてください

質問

エクセルvbaで、同じ番号の請求書の金額をまとめる方法を教えてください。

A B C D
11/5 B575 3000
11/5 B575 4500
11/6 B578 3000

上記のように　A日付　B請求書番号　C請求金額　が入力されています。
D列に同じ請求書番号の合計金額をセルを結合して中央揃えで表示したいのです。

同じ請求書番号は固まって入力されています。ランダムではありません。
同じ請求書番号は最大で５つくらいです。
同じ請求書番号のないものは、D列にC列と同じものを表示します。
行は最大でも100行程度ですが、データの無いところで止まって終了とします。

ご多忙の中申し訳ございませんがよろしくお願いします。

回答No.3

Wendy02 · ベストアンサー

>行は最大でも100行程度ですが、データの無いところで止まって終了とします。
途中でデータがないところがあるという意味ではないと思いますが、データの最後のところまで調べます。

'標準モジュール推奨
Sub MacroTest1()
Dim i As Long, j As Long
Dim buf As Variant, ret As Double
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
　buf = Cells(i, 3).Value
　If Cells(i, 2).Value <> Cells(i + 1, 2).Value Then
　　 If j = 0 Then j = i
　　 With Range(Cells(j, 4), Cells(i, 4))
　　　　.MergeCells = True
　　　　.HorizontalAlignment = xlCenter
　　　　.VerticalAlignment = xlCenter
　　 End With
　　 If buf + ret > 0 Then
　　 Cells(j, 4).Value = buf + ret
　　 End If
　　 Cells(j, 4).NumberFormat = "#,##0"
　　 ret = 0: j = 0
　Else
　　 If j = 0 Then j = i
　　 ret = buf + ret
　End If
Next
''合計欄
'With Cells(i, 4)
'　.NumberFormat = "#,##0"
'　.HorizontalAlignment = xlCenter
'　.Formula = "= SUM(R1C:R[-1]C)"
'End With
End Sub

お礼

ありがとうございました。
迅速なご回答に感謝します。
さっそく、試してみることにします。

補足

試してみました。
質問のサンプルでは無事に起動しました。
ありがとうございました。

実際は、C列はI列に、D列はK列になるので列の数字を修正（3=>9 4=>11）
したものを走らせたのですが、
これですと、

実行時エラー　13　　　型が一致しません

という表示が出てしまいます。
デバックを見ると
If buf + ret > 0 Then
のところで止まっています。

解決策はご存知でしょうか。
また、ファイルにはオートフィルターがかけてあります。
これが影響してしまうのでしょうか。

回答No.5

Wendy02

>C列はI列に、D列はK列になるので列の数字を修正（3=>9 4=>11）
これはこれで良いと思います。

>実行時エラー　13　　　型が一致しません

こちらで試してみましたが、エラーが出ませんので、たぶん、I列に数値データが入っていないからだと思います。以下のように直してみてください。

#3のコードの6行目付近の

buf = Cells(i, 3).Value
　　　↓
buf = Val(Cells(i, 9).Value) '修正

お礼

ご指摘通り修正したら動きました。

ご多忙の中、ありがとうございました。

本当に助かります。

回答No.4

mu2011

NO1,2です。
対象のシートタブ上で右クリック→コードの表示→以下のコード貼り付けてお試しください。

Sub sample01()
Columns("D").Clear
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(i, "A") = "" Then Exit Sub
amnt = amnt + Cells(i, "C")
If Cells(i + 1, "B") = Cells(i, "B") Then
cnt = cnt + 1
Else
Range(Cells(i - cnt, "D"), Cells(i, "D")).Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.MergeCells = True
End With
Cells(i - cnt, "D") = amnt
amnt = 0: cnt = 0
End If
Next
End Sub

お礼

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

先の方の方法でやってみましたので、貴方のは今後の参考にいたします。

回答No.2

mu2011

NO1です。
ＶＢＡでの回答希望を失念ておりました、参考程度に読み捨て下さい。

回答No.1

mu2011

一例です。
（１）D1に=SUMIF(B:B,B1,C:C)として、フィルボタン（D1セルを選択すると右枠下の■表示される）をダブルクリック
（２）Ｄ列の同じ請求書番号セルを結合し、中央表示に書式設定して下さい