• ベストアンサー

エクセルVBAにてA列の数字の合計をA列のラスト行に入力したい。

お世話になります。 表題通りです。 エクセルにてセルのA.1~2・3と順番に数字が入っています。但し、終わりが決まっていません。 このA列のデータの入っていないセルにA列の合計を自動で入れたいのですが、 Range("A100").End(xlUp).Offset.Select ラスト行のセルを所得して、このセルにSUM(上)を入れたいのですが、 どのように書けばよいか教えて下さい。宜しくお願い致します。

  • aieeen
  • お礼率66% (123/185)

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

  • ベストアンサー
  • ja7awu
  • ベストアンサー率62% (292/464)
回答No.1

こんな感じになると思います。 Sub test()   Range("A100").End(xlUp).Offset(1).Select   ActiveCell.Formula = "=SUM(A1:A" & ActiveCell.Row - 1 & ")" End Sub ただ、これですと、何回も実行すると、SUM関数の数式を入れたセルも次々加算する ことになりますので、これを防ぐため、一番下が数式のときは、そのセルに 上書きするようにするのであれば、こんな感じになると思います。 Sub test2() With Range("A100").End(xlUp)   If .HasFormula Then     .Formula = "=SUM(A1:A" & .Row - 1 & ")"   Else     .Offset(1).Formula = "=SUM(A1:A" & .Row & ")"   End If End With End Sub

aieeen
質問者

お礼

ありがとうございます。 解決いたしました。 数式の時は上書きするのは、 ビックリしました。親切にありがとうございます。

関連するQ&A

  • エクセルVBAによる不連続データ群の合算と、ワークシートをまたぐ連続処理について

    エクセルのVBAによる、合算処理が上手くいかずに困っています。 現在の状況ですが、1つのワークブックト中に、 いくつかのシートに分かれたデータ群があります。 それぞれのシートごとのデータ群で合算したいと思っています。 1つのデータ群に対してのVBAは作成できたのですが、 それぞれのデータ群ごとに合算しつつ、シートをまたいで 連続処理することができません。 お知恵を拝借できれば幸いです。 Workbook Sheet1の内容    [ A ][ B ][ C ][ D ][ E ] [ 1] 日付 品名 予算 金額 差額 [ 2] 3/1 aaa 1000 200 800 [ 3] 3/1 bbb 500 100 400 [ 4] 3/1 ccc 600 200 400 [ 5]   合計 2100 500 1600 [ 6]  [ 7] 日付 品名 予算 金額 差額 [ 8] 2/1 ddd 1000 500  500 [ 9] 2/1 eee 2000 600 1400 [10] 2/1 fff 1800 1200  600 [11]  合計 4800 2300 2500 [12] [13] 日付 品名 予算 金額 差額    以下、同一シート内にデータ群が続いていき、    さらにWoorkbook Sheet2, Sheet3 ..... と続きます。    以下、自作のVBA Sub sample() Dim my_last_row As Long '最終行の行数用 Dim my_last_address_sum As Long '最終行から一つ下のセル(合計用のセル)のアドレス取得用 my_last_row = Range("D65536").End(xlUp).Row my_last_address_sum = Range("D65536").End(xlUp).Offset(1).Address(RowAbsolute:=False) '=sum関数の埋め込み Range(my_last_address_sum).Formula = "=sum(C1:" & "C" & Format(my_last_row) & ")" '=sum関数を埋め込んだセルのコピー Range(my_last_address_sum).Copy '=sum関数を埋め込んだセルから、右に1つ分だけセルを移動する Range(my_last_address_sum).Offset(0, 1).Select '移動したセルを基準にして、右に2つ分だけセルを拡張する(合計3セルを選択する) Range(ActiveCell, ActiveCell.Offset(0, 2)).Select '選択した3つのセルに対して、=sum関数を埋め込んだセルのペーストする ActiveSheet.Paste 'セルA1に戻る Range("A1").Select End Sub

  • EXCEL VBA 早く処理をする

    よろしくお願いします 下の構文を標準モジュールに書き込み、callで実行しているのですが 処理に時間がかかります。 処理を早くする方法と構文の簡素化のご教示をお願いします。 Application.ScreenUpdating = False For i = 1 To 12 With Worksheets(i) .Select LastRow = .Range("A150").End(xlUp).Row + 1 .Range("A8:G" & LastRow).Sort Key1:=Range("A8"), order1:=xlAscending .Range("G8:G" & LastRow - 1).Formula = "=G7+E8-F8" LastRow = .Range("A150").End(xlUp).Row + 1 .Range("A" & LastRow).Select Dim EndRow As Long EndRow = .Range("A" & Rows.Count).End(xlUp).Row Cells(Rows.Count, 1).End(xlUp).Offset(1, 3) = .Name & "合計" Cells(Rows.Count, 1).End(xlUp).Offset(1, 4) = Application.WorksheetFunction.Sum(Range("E7:E" & EndRow)) Cells(Rows.Count, 1).End(xlUp).Offset(1, 5) = Application.WorksheetFunction.Sum(Range("F7:F" & EndRow)) Cells(Rows.Count, 1).End(xlUp).Offset(2, 3) = "前月繰越" Cells(Rows.Count, 1).End(xlUp).Offset(2, 4) = .Range("G7") Cells(Rows.Count, 1).End(xlUp).Offset(2, 5) = "" Cells(Rows.Count, 1).End(xlUp).Offset(3, 4) = "" Cells(Rows.Count, 1).End(xlUp).Offset(3, 3) = "次月繰越" Cells(Rows.Count, 1).End(xlUp).Offset(4, 3) = "合計" Cells(Rows.Count, 1).End(xlUp).Offset(3, 5) = Cells(Rows.Count, 1).End(xlUp).Offset(2, 4) + Cells(Rows.Count, 1).End(xlUp).Offset(1, 4) - Cells(Rows.Count, 1).End(xlUp).Offset(1, 5) Cells(Rows.Count, 1).End(xlUp).Offset(4, 4) = Cells(Rows.Count, 1).End(xlUp).Offset(2, 4) + Cells(Rows.Count, 1).End(xlUp).Offset(1, 4) Cells(Rows.Count, 1).End(xlUp).Offset(4, 5) = Cells(Rows.Count, 1).End(xlUp).Offset(3, 5) + Cells(Rows.Count, 1).End(xlUp).Offset(1, 5) Cells(Rows.Count, 1).End(xlUp).Offset(1, 6) = "" Cells(Rows.Count, 1).End(xlUp).Offset(2, 6) = "" Cells(Rows.Count, 1).End(xlUp).Offset(3, 6) = "" Cells(Rows.Count, 1).End(xlUp).Offset(4, 6) = Cells(Rows.Count, 1).End(xlUp).Offset(0, 6) .Range("C7").End(xlDown).Select Selection.Offset(4, 2).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(4, 2).Borders(xlEdgeBottom).LineStyle = xlDouble Selection.Offset(4, 3).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(4, 3).Borders(xlEdgeBottom).LineStyle = xlDouble Selection.Offset(4, 4).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(4, 4).Borders(xlEdgeBottom).LineStyle = xlDouble Selection.Offset(0, 2).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(0, 2).Borders(xlEdgeBottom).LineStyle = xlContinuous Selection.Offset(0, 2).Borders(xlEdgeBottom).Weight = xlThin Selection.Offset(0, 3).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(0, 3).Borders(xlEdgeBottom).LineStyle = xlContinuous Selection.Offset(0, 3).Borders(xlEdgeBottom).Weight = xlThin Selection.Offset(0, 4).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(0, 4).Borders(xlEdgeBottom).LineStyle = xlContinuous Selection.Offset(0, 4).Borders(xlEdgeBottom).Weight = xlThin End With Next i Application.ScreenUpdating = True

  • エクセルVBAで値のカウントをしたい

    C列~AA列まで値が入っています 1行目にはタイトル 2行目からそれぞれ値が入っており、終了行は毎回ランダムです 各列毎に値の合計と1以上の値の合計数を表示するために下記のマクロを使用しているのですが、もっとスマートな方法は無いでしょうか? 現在のマクロだとマクロ行数がとても多いものになっています。 Sub Count() With Range("C2") .End(xlDown).Offset(1, 0) = _ "=SUM(" & Range(.Address, .End(xlDown)).Address(False, False) & ")" End With '本当はCの最終行に直接COUNTIFを書き込みたいが、他のセルを使用しないと0になる Range("A1") = "=COUNTIF(C2:C10000,"">=1"")" Range("A1").Select Selection.Copy Range("C1").End(xlDown).Offset(1, 0).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CommandBars("Stop Recording").Visible = False With Range("D2") .End(xlDown).Offset(1, 0) = _ "=SUM(" & Range(.Address, .End(xlDown)).Address(False, False) & ")" End With Range("A1") = "=COUNTIF(D2:D10000,"">=1"")" Range("A1").Select Selection.Copy Range("D1").End(xlDown).Offset(1, 0).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CommandBars("Stop Recording").Visible = False '以降AAまでセルの位置を変えた同一マクロを繰り返す End Sub

  • エクセル オートフィルタ中の最終行移動マクロ

    表題について質問させていただきます。 行数の決まっていないA~E列までデータが入っている表があります。 仮に10行だったとして、マクロの操作でA11に移動させるには、以下で可能だったのですが、 ・Range("A65536").End(xlUp).Offset(1).Select ・Range("A1").End(xlDown).Offset(1,0).Select オートフィルタ実行中は不可視セルが選択されてしまい上記例のA11に移動できません。 オートフィルタ実行中にもA11へ移動する方法をご教授願います。 ※行数が15行のときはA16へ移動。  新規に入力する行へ移動することが望みです。 エクセル2003です よろしくお願いいたします。

  • 最終行に合計(最終行が列によって異なる場合)

    エクセルVBAに於いて質問させて頂きます。 タイトルにも書かせていただきましたが、 A列に行数可変のデータ(文字列)があり、 B列に行数可変のデータ(数字)があり、 A列の行数>=B列の行数の条件とき、 A列の最終行+2の位置のA列に文字で合計 A列の最終行+2の位置のB列にsumを表示する場合、 どのようにすれば出来ますでしょうか。 A列の最終行+2の位置のA列に文字で合計は With Range("A3") .End(xlDown).Offset(2, 0).Formula = "合計" End With でいけると思うのですが、 A列の最終行+2の位置のB列にsumを表示する場合どのようにすればいいのかわかりません。 ご教授のほどお願い致します。

  • エクセルVBAで行のコピー貼り付けについて

    初心者、勉強中でエクセル2007です。 A1行からK40行までの表があります。 これを下にコピーをしながら増やしていってるのですが、マクロでしようと思い下記のとおり 考えました。 selecion.row.Offset(39, -1).Select ここでオブジェクトが必要ですと出ます。 それからその下の?とを色々ぐぐってみますがどうしてもわかりません。 それと2007ですので65536行ではないのですが、MaxRow = Cells(Rows.Count, 1).End(xlUp).Row だと動かないみたいですので下記としています。 よろしくご教授お願いします。 Sub Gcopy() MaxRow = Range("B65536").End(xlUp).Offset(-39, -1).Select データの入ってる最終行を取得 Selecion.row.Offset(39, -1).Select 選択された行から上に39行移動し選択 ?                    下へ39行まで選択   MaxRow = Range("B65536").End(xlUp).Offset(1, -1) 最終行を取得 ActiveSheet.Paste 貼り付け End Sub

  • エクセル VBA マクロについて

    VBA初心者です。 Sub 記入() Range("H8", "J14").Copy Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats Application.CutCopyMode = False Range("H15", "J21").Copy Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats Application.CutCopyMode = False Range("H22", "J28").Copy Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats Application.CutCopyMode = False Range("K13").Select End Sub こういうマクロを作り上手く作動しましたのでB列に日付を記入したいと思い Sub 日付() Range("("B" & Rows.Count).End(xlUp).Offset(1)","("C" & Rows.Count).End(xlUp).Offset(0, -1)").Value = Date End Sub このようなマクロを組みましたがエラーがでます。どなたか直して頂けませんか?よろしくお願いします。

  • エクセル マクロで行の合計を数値で入力したい

    マクロ初心者です。 F列からAJ列までの合計をAK列に数値で入力しようとしています。 ただし、FからAJ列の各セルに全てデータは入っていません。 したがってFからAJ列のいずれかにデータが入っている最終行を 見つけて合計を算入しようとしているのですが下記の通りやっても うまくいきません。教えてください。 エクセルのバージョンは2002です。 Sub () 'データが入っている最終行まで合計額を数字で入力 LastRow = Cells(65536, COL).End(xlUp).Row For i = LastRow To 6 Step -1 Set myRange = Range(Cells(i, 6), Cells(i, 36)) Cells(i, 37).Value = WorksheetFunction.Sum(myRange) Next i End Sub

  • エクセルVBA 結構初歩的なことですが・・・;;

    下のような文を作りたいのですが、表記方法がどうして良いか悩んでます;; a = Cells(65536, 22).End(xlUp).Offset(-3, 0) Range("A1:a").Select 1行目のaでセルの場所を指定しますよね、 A1から1行目で指定したaの場所まで範囲指定したいのです。 宜しくお願い致します;;

  • エクセルVBA の変数を使うべきでしょうか?

    はじめまして。エクセル初心者です。 書籍やサイトで勉強させてもらっていますが、VBAがなかなか難しくてすぐに壁にぶつかってしまいます。少々困ってしまい、詳しい方のアドバイスを頂ければと質問を投稿させていただきました。 どうか宜しくお願い致します。質問ですが、 以下のようなコードで、sheet5のB列の任意のセルをダブルクリックした場合、sheet5のBCD列の同じ行のセル値がsheet1の指定した列に入力されるという処理を作りました。 これで一応目的の動作はするのですが、数が増えると「コンパイルエラー・プロシージャが大きすぎます」というメッセージがでてしまいます。列や行には規則性があるので、もしかしたら変数というものを使ってコードを書き直せばいいのかなと思いネットで調べてみたのですが、今のところさっぱり理解できません。 申し訳ありませんが、分かりやすくご教授いただけないでしょうか。バージョンは2003を使っています。 また、下のコードですと、sheet5のBCDいずれかのセルに空白があった場合、sheet1の列に入力されるときに入力される行がずれてしまいます。今は空白を何かで埋めて対処しているのですが、この問題の解決策も教えて頂けると助かります。どうか宜しくお願い致します。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, cancel As Boolean) If Target.Address = "$B$2" Then Worksheets("sheet1").Range("B" & Rows.Count).End(xlUp).Offset(1).Value = Target.Value Worksheets("sheet1").Range("H" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("B2") Worksheets("sheet1").Range("K" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("C2") Worksheets("sheet1").Range("M" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("D2") Worksheets("sheet1").Activate cancel = True End If If Target.Address = "$B$3" Then Worksheets("sheet1").Range("B" & Rows.Count).End(xlUp).Offset(1).Value = Target.Value Worksheets("sheet1").Range("H" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("B3") Worksheets("sheet1").Range("K" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("C3") Worksheets("sheet1").Range("M" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("D3") Worksheets("sheet1").Activate cancel = True End If If Target.Address = "$B$4" Then Worksheets("sheet1").Range("B" & Rows.Count).End(xlUp).Offset(1).Value = Target.Value Worksheets("sheet1").Range("H" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("B4") Worksheets("sheet1").Range("K" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("C4") Worksheets("sheet1").Range("M" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("D4") Worksheets("sheet1").Activate cancel = True End If   ・     ・   ・     ・   ・     ・ End Sub

専門家に質問してみよう