EXCEL VBA 行の値を累計したいのですが・・

VBA初心者です。
VBAでEXCELの行の値を累計したいのですが、プログラムの仕方がわかりません。
どなたかわかる方教えてください。

　　　 A　　 　B　　 C　　　 D　　　E　・・・・
1　　1000　3000　2000　4000　3000　
2　　2000　5000　1000　3000　2000　
3　　4000　2000　3000　1000　5000　　
:
　　　
実行結果
　　 　A　　　 B 　　 C　　 　D 　　 E　　・・・・
1　　1000　4000　6000　10000　13000
2　　2000　7000　8000　11000　13000　　　←行の値の累計
3　　4000　6000　9000　10000　15000
:

行と列はたくさんあって、最後のセルまで累計する方法を教えていただけるとありがたいです。
どうぞよろしくお願いします。m(_ _)m

No.1 ベストアンサー 回答者： hige_082 回答日時： 2010/02/03 21:41

数式の方が簡単ですよね

VBAの方も初歩的なことですが
一応提示しておきますが

Sub test()
Dim x, y
For x = 1 To 3 　　'行数
For y = 1 To 5 　　'列数
If y = 1 Then
Worksheets("sheet2").Cells(x, y).Value = Worksheets("sheet1").Cells(x, y).Value
Else
Worksheets("sheet2").Cells(x, y).Value = Worksheets("sheet1").Cells(x, y).Value + Worksheets("sheet1").Cells(x, y).Offset(, -1).Value
End If
Next y
Next x
End Sub

参考？まで

この回答へのお礼

hige_082さん、ありがとうございます。
とても参考になりました！

お礼日時：2010/02/11 13:32

No.2 回答者： Wendy02 回答日時： 2010/02/03 23:26

こんばんは。

必ず、マトリックス（格子状）になっていることが条件です。
累計は上書きしてしまいます。マクロを行った直後だったら、元に戻すことも可能です。ただし、あまり大きな表ですと、どうなるか不明です。出来る限り、一旦保存してからのほうが安全です。

'-------------------------------------------

Option Explicit
Dim arBackUp As Variant　'バックアップ用
Sub CumilativePastePr()
　　Dim rng As Range
　　Dim r1 As Range
　　Dim r2 As Range
　　Dim i As Long
　　Set rng = Range("A1").CurrentRegion
　　arBackUp = rng.Value
　　Application.ScreenUpdating = False
　　With rng
　　　　For i = 2 To .Columns.Count
　　　　　　Set r1 = .Columns(i - 1)
　　　　　　Set r2 = .Columns(i)
　　　　　　r2Sum r1, r2
　　　　Next i
　　End With
　　Application.ScreenUpdating = True
　　Set rng = Nothing
　　Set r1 = Nothing : Set r2 = Nothing
End Sub
Private Sub r2Sum(r1 As Range, r2 As Range)
Dim i As Variant
Dim ar1 As Variant
Dim ar2 As Variant
　ar1 = r1.Value
　ar2 = r2.Value
　For i = 1 To r1.Rows.Count
　　r2.Cells(i, 1).Value = ar1(i, 1) + ar2(i, 1)
　Next i
End Sub
'-------------------------------------------
'おまけ
Sub RetrivalOrg()
'元に戻すマクロ
Dim x As Long
Dim y As Long
On Error Resume Next
x = UBound(arBackUp, 1)
y = UBound(arBackUp, 2)
If Err.Number > 0 Then MsgBox "元には戻りません。", 48: Exit Sub
On Error GoTo 0
　Range("A1").Resize(x, y).Value = arBackUp
End Sub
----------------------------------------

この回答へのお礼

Wendy02さん、ありがとうございます。
とても参考になりました！

お礼日時：2010/02/11 13:31