エクセルvbaで、同じ番号の請求書の金額をまとめる方法 2

エクセルvbaで、同じ番号の請求書の金額をまとめる方法　2

すみません、前回質問して良い回答をいただいたのですが、こちらの手違いで
用件がひとつぬけていました。

A 　　　B　　　　 I 　　　K 　　　L 　　　 M
11/5 B575 　　　3000　　7500 5000 13500
11/5 B575 　　　4500 　　　　　8500
11/6 B578 　　　3000 　 3000 4000 40000

上記のように　A日付　B請求書番号　I金額　K金額合計　が入力されています。
（IからKにとんでいるのは間違いではありません）
M列にも同じようにL列の同じ請求書番号の金額の合計をセルを結合して中央揃えで表示したいのです。
以前のプログラムに加筆することで可能になるでしょうか。
下に貼り付けます。

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 = Val(Cells(i, 9).Value) '修正
If Cells(i, 2).Value <> Cells(i + 1, 2).Value Then
If j = 0 Then j = i
With Range(Cells(j, 11), Cells(i, 11))
.MergeCells = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
If buf + ret > 0 Then
Cells(j, 11).Value = buf + ret
End If
Cells(j, 11).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

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

No.1 ベストアンサー 回答者： Wendy02 回答日時： 2010/11/06 00:35

修正しました。

I列とL列とは同じ構造で連動していることが条件です。
前回から修正を加えたのは、書式で右側を開け、桁揃えをすることにしました。
'.HorizontalAlignment = xlCenter '修正　そのために、コメントブロックしています。
合計欄のコメントブロックを外すと、K列、M列に最後のデータの次に合計が出ます。

'//
Sub MacroTest2()
　Dim i As Long, j As Long
　Dim buf As Variant, ret As Double
　Dim buf2 As Variant, ret2 As Double
　Application.ScreenUpdating = False
　For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
　　buf = Val(Cells(i, 9).Value) 'I
　　buf2 = Val(Cells(i, 12).Value) 'M
　　If Cells(i, 2).Value <> Cells(i + 1, 2).Value Then
　　If j = 0 Then j = i
　　　With Range(Cells(j, 11), Cells(i, 11)) 'K
　　　　.MergeCells = True
　　　　'.HorizontalAlignment = xlCenter '修正
　　　　.VerticalAlignment = xlCenter
　　　End With
　　　With Range(Cells(j, 13), Cells(i, 13)) 'L
　　　　.MergeCells = True
　　　　'.HorizontalAlignment = xlCenter '修正
　　　　.VerticalAlignment = xlCenter
　　　End With
　　　''0の場合は出力しないが、0を出力する場合はIf--End If を辞める
　　　If buf + ret > 0 Then
　　　　Cells(j, 11).Value = buf + ret
　　　End If
　　　If buf2 + ret2 > 0 Then
　　　　Cells(j, 13).Value = buf2 + ret2
　　　End If
　　　Cells(j, 11).NumberFormat = "#,##0_　"
　　　Cells(j, 13).NumberFormat = "#,##0_　"
　　　ret = 0: j = 0
　　　ret2 = 0
　　Else
　　If j = 0 Then j = i
　　　ret = buf + ret
　　　ret2 = buf2 + ret2
　　End If
　Next
　''合計欄
'　With Cells(i, 11)
'　　.NumberFormat = "#,##0_　"
'　　.Formula = "= SUM(R1C:R[-1]C)"
'　　.Offset(, 2).Formula = "= SUM(R1C:R[-1]C)"
'　End With
'　Application.ScreenUpdating = True
End Sub

p.s.おそらく、この先に、見栄えを整えるために、罫線を入れたいという要求があるかもしれませんが、とりあえずは、ここまでにします。必要な場合は、画像を入れてくださるとありがたいです。

この回答へのお礼

稼働しました。
夜遅くにもかかわらず、たいへんありがとうございました。
再度のご対応に感謝いたします。

お礼日時：2010/11/06 08:23