• ベストアンサー

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

質問者が選んだベストアンサー

  • ベストアンサー
  • hige_082
  • ベストアンサー率50% (379/747)
回答No.1

数式の方が簡単ですよね 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 参考?まで

VBAbiginer
質問者

お礼

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

その他の回答 (1)

  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.2

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

VBAbiginer
質問者

お礼

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

関連するQ&A