- ベストアンサー
エクセル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
- RoToTo3
- お礼率80% (8/10)
- Visual Basic
- 回答数10
- ありがとう数10
- みんなの回答 (10)
- 専門家の回答
質問者が選んだベストアンサー
ANo.7です。 >仮にSheet3が空シートだった場合に、マクロがエラーで中断します。 空シートとはデータが一切ない物とします。 (項目行を含め、何もない状態) Sub test2() Dim ws As Worksheet Dim r As Range Dim rr As Range, rs As Range For Each ws In Worksheets With ws If .UsedRange.Cells.Count < 2 Then Set r = Nothing Else Set r = Intersect(.UsedRange.SpecialCells(xlTextValues), .Range("B:B")) End If End With If Not r Is Nothing Then For Each rr In r.Areas Set rs = rr.Offset(1).Resize(rr.Rows.Count - 1) With rr.Offset(rr.Rows.Count).Resize(1) .Formula = "合計" .Offset(, 1).Resize(, 3).Formula = "=SUM(" & rs.Offset(, 1).Address(0, 0) & ")" End With Next End If Next Set r = Nothing Set rs = Nothing End Sub ご参考になれば。
その他の回答 (9)
- n-jun
- ベストアンサー率33% (959/2873)
ANo.8です。 まだ閉じられていなかったので、Find版を考えてみました。 素人考えなのでごちゃごちゃしてしまいましたが。 Sub try() Dim ws As Worksheet Dim AreaRange As Range Dim FindRange As Range Dim F_Address As String For Each ws In Worksheets With ws Set FindRange = .Range("A:A").Find( _ What:="日付", After:=.Range("A" & Rows.Count)) If Not FindRange Is Nothing Then F_Address = FindRange.Address Do Set AreaRange = FindRange.CurrentRegion If Application.CountIf(AreaRange, "合計") < 1 Then With AreaRange.Offset(AreaRange.Rows.Count, 1).Resize(1, 1) .Value = "合計" .Offset(, 1).Resize(1, 3).Formula = "=sum(" & AreaRange.Offset(1, 2) _ .Resize(AreaRange.Rows.Count - 1, 1).Address(0, 0) & ")" End With End If Set FindRange = .Range("A:A").FindNext(FindRange) Loop Until F_Address = FindRange.Address End If End With Next Set FindRange = Nothing Set AreaRange = Nothing End Sub ”A列の「日付」”を検索してます。 Findメソッドは引数を余り省略しない方がよいと、諸先輩方の回答で勉強しました。 今回は検索開始位置をA列の一番最後からにしています。 よって初めに見つけるのは各シートのA1になるはずです。 ご参考になれば。
お礼
n-junさま 何度もありがとうございます。いろいろ勉強になります。 人それぞれの手法があって興味深いです。 どうもありがとうございました。 追伸 仕事は営業マンなので、単なる仕事の効率化が目標でしたが、 マクロの初歩をかじってみると、プログラムの基本的な考え方が 分かっていないとプログラムそのものが場当たりなものになると 痛切に感じています。これを契機に精進したいと思っています。 謹んで回答を閉めさせていただきます。
- n-jun
- ベストアンサー率33% (959/2873)
ANo.8です。 >If .UsedRange.Cells.Count < 2 Then >ここのcountがなぜ<2なのでしょうか? >私の考えではcells.countしても、データがないので「0」になる。 >なので、 >If .UsedRange.Cells.Count < 1 Then >でもいいように感じています。 >そこで、実際に1にしてマクロを実行すると >Set r = Intersect(.UsedRange.SpecialCells(xlTextValues), .Range("B:B")) >でエラーになります。 実は私も当初同じ考えでコードを作ったのですが、同じエラーになりました。 エラーが発生した際に If .UsedRange.Cells.Count < 1 Then にマウスを合わせてみると .UsedRange.Cells.Count = 1 となってます。 即ちアクティブなセル1個をカウントしていると判断し、"<2"としました。 素人考えなので正確かはわかりませんが、結果から多分そうだと思います。
お礼
n-junさま お返事どうもありがとうございました。 委細を了解いたしました。 重ねてお礼申し上げます。
- n-jun
- ベストアンサー率33% (959/2873)
ANo.2です。 初めの質問だけでの解釈ですが。 Sub test() Dim ws As Worksheet Dim r As Range Dim rr As Range For Each ws In Worksheets With ws Set r = Intersect(.UsedRange.SpecialCells(xlTextValues), .Range("B:B")) End With For Each rr In r.Areas With rr.Offset(rr.Rows.Count).Resize(1) .Formula = "合計" .Offset(, 1).Formula = "=SUM(" & rr.Offset(, 1).Address(0, 0) & ")" .Offset(, 2).Formula = "=SUM(" & rr.Offset(, 2).Address(0, 0) & ")" .Offset(, 3).Formula = "=SUM(" & rr.Offset(, 3).Address(0, 0) & ")" End With Next Next Set r = Nothing End Sub 取違でしたらスル~して下さい。
お礼
n-junさま ご回答どうもありがとうございました。 理解しながら進めておりますので、 お返事まで時間がかかっております。 どうもすみません。 このサンプルも大変に参考になります。 解決方法はいろいろあるのだと実感しております。 また実行結果について、ひとつ相談させてください。 たとえば、WorkbookのWorkSheetが、Sheet1,Sheet2,Sheet3とあり 仮にSheet3が空シートだった場合に、マクロがエラーで中断します。 事前に空シートを削除しておけばよいことまでは理解しました。 そこでマクロ内に、この問題を回避する処理を組み込もうと 考えたのですがうまくいきません。 良案があればどうかご教授ください。
- redfox63
- ベストアンサー率71% (1325/1856)
すみません Set rTop = rWork.FindNext( rTop ) で rTopが Nothingになってしまうのは Findを実行していないためです マクロの冒頭を Set rOrg = ActiveSheet.Range("A1").CurrentRegion Set rWork = Intersect(ActiveSheet.UsedRange, Range("A:A")) Set rTop = rWork.Find("日付") と変更してください
補足
redfox63さま ご回答どうもありがとうございます。 Debug.Print たいへん参考になりました。 また、イミディエイトウィンドウの活用方法を知りました。 お礼申し上げます。 さて、ご呈示の内容に従い、以下のようなマクロにしました。 実行結果ですが、初回のサンプルデータでいうところの データ群1と3以降は、合算されますが、 データ群2の部分だけが、合算されません。 rtopがセル「A7」になっているため、 マクロ処理中にスキップされてしまうことまでは わかりましたが、解決方法が浮かびません。 rtopを強制的にセル「A1」にすると データの先頭行に空白があった場合に 問題がありそうで良案が思い浮かびません。 質問ばかりで恐縮ですが、良案があれば お教えください。 Sub test_macro1() Dim rOrg As Range, rData As Range, rSum As Range Dim rTop As Range, rWork As Range Dim ss As String 'データ範囲を取得 Set rOrg = ActiveSheet.Range("A1").CurrentRegion Set rWork = Intersect(ActiveSheet.UsedRange, Range("A:A")) Set rTop = rWork.Find("キャンペーン期間") ss = rTop.Address(0, 0) Debug.Print rWork.Address(0, 0) Debug.Print rTop.Address(0, 0) 'データ範囲を取得 ' Set rTop = ActiveSheet.Range("A1") ' Set rOrg = rTop.CurrentRegion ' Set rWork = Intersect(ActiveSheet.UsedRange, Range("A:A")) ' ss = rTop.Address(0, 0) Do ' 取得範囲が2行以下なら処理中断 If rOrg.Rows.Count < 2 Then Exit Do End If ' 取得範囲からデータ領域のみを抽出 Set rData = rOrg.Offset(1).Resize(rOrg.Rows.Count - 1) '合計行があるなら 1行マイナス 無ければ『合計』を転記 If rData(rData.Rows.Count, 2) = "合計" Then Set rData = rData.Resize(rData.Rows.Count - 1) Else rData.Offset(rData.Rows.Count, 1).Resize(1, 1).Value = "合計" End If ' 合計の数式範囲を設定 Set rSum = rData.Offset(rData.Rows.Count, 2).Resize(1, rData.Columns.Count - 2) ' 数式 SUMを設定 rSum.FormulaR1C1 = "=SUM(R[-1]C:R[-" & rData.Rows.Count & "]C)" ' 次のデータ範囲を取得 Set rTop = rWork.FindNext(rTop) If rTop Is Nothing Then Exit Do End If Set rOrg = rTop.CurrentRegion ' 取得した範囲の左上のセルが 空セルなら終了 Loop While rTop.Address(0, 0) <> ss End Sub
- redfox63
- ベストアンサー率71% (1325/1856)
rWorkの取得範囲は正常なのでしょうか? シートに記入されている範囲のA列のみを中質している予定なのですが 最初のデータ群の範囲しか取得してないのかも マクロの冒頭にある Set rWork = Intersect(ActiveSheet.UsedRange, Range("A:A")) で取得した後 Debug.Print rWork.Address(0,0) などとして確認してみてください 『日付』の記入列が A列なんですよね …
- redfox63
- ベストアンサー率71% (1325/1856)
では 日付をFindメソッドで探しましょう Sub Macro1() Dim rOrg As Range, rData As Range, rSum As Range Dim rTop As Range, rWork As Range Dim ss As String 'データ範囲を取得 Set rTop = ActiveSheet.Range("A1") Set rOrg = rTop.CurrentRegion Set rWork = Intersect(ActiveSheet.UsedRange, Range("A:A")) ss = rTop.Address(0, 0) Do ' 取得範囲が2行以下なら処理中断 If rOrg.Rows.Count < 2 Then Exit Do End If ' 取得範囲からデータ領域のみを抽出 Set rData = rOrg.Offset(1).Resize(rOrg.Rows.Count - 1) '合計行があるなら 1行マイナス 無ければ『合計』を転記 If rData(rData.Rows.Count, 2) = "合計" Then Set rData = rData.Resize(rData.Rows.Count - 1) Else rData.Offset(rData.Rows.Count, 1).Resize(1, 1).Value = "合計" End If ' 合計の数式範囲を設定 Set rSum = rData.Offset(rData.Rows.Count, 2).Resize(1, rData.Columns.Count - 2) ' 数式 SUMを設定 rSum.FormulaR1C1 = "=SUM(R[-1]C:R[-" & rData.Rows.Count & "]C)" ' 次のデータ範囲を取得 Set rTop = rWork.FindNext(rTop) If rTop Is Nothing Then Exit Do End If Set rOrg = rTop.CurrentRegion ' 取得した範囲の左上のセルが 空セルなら終了 Loop While rTop.Address(0, 0) <> ss End Sub # 我々回答者は 質問内容や補足事項を手がかりに回答するしかありません # 例示のレイアウトでテストを行ったりしておりますのでこれ以外のケースを想定していません
お礼
redfox63さま 回答どうもありがとうございます。 ソースを見ていると、とても勉強になります。 しかしながら、なぜか連続処理がうまくいきません。 ウォッチを見ていると、 Set rTop = rWork.FindNext(rTop) ループの初回に Nothingとなってしまい Exit処理されてしまいます。 つまり、1つめのデータ群には、 合計(合算)が付加されるのですが 以降のデータ群が合計(合算)されません。 ソースは単純かつ分かりやすいので、 私のPC環境固有の問題も疑っています。 EXCELのVersionをお伝えし忘れていましたが Excel2003でWindowsXP環境です。 回答をいただきながら大変に恐縮ですが、 何かヒントはありませんでしょうか?
- redfox63
- ベストアンサー率71% (1325/1856)
1)『日付』のセルを基点に CurrentRegionでデータ範囲を取得 1-1) 取得範囲が2行未満の場合処理中断 2) 取得したデータ範囲を 題目と合計行の分小さくする 3) 2)の範囲から数式SUMの範囲を選定 4) FomulaR1C1で数式を設定 5) 1)で取得した範囲を その範囲のRows.Count+1ずらして 1)から実行 Sub Macro1 dim rOrg as Range, rData as Range, rSum as Range 'データ範囲を取得 set rOrg = ActiveSheet.Range("A1").CurrentRegion do ' 取得範囲が2行以下なら処理中断 if rOrg.Rows.Count < 2 then exit do end if ' 取得範囲からデータ領域のみを抽出 set rData = rOrg.Offset(1).Resize( rOrg.Rows.Count - 1 ) ’合計行があるなら 1行マイナス 無ければ『合計』を転記 if rData(rData.Rows.Count, 2) = "合計" then set rData = rData.Resize( rData.rows.Count -1 ) else rData.Offset( rData.Rows.Count, 1).Resize(1,1).Value = "合計" end if ' 合計の数式範囲を設定 set rSum = rData.Offset( rData.Rows.Count,2) ' 数式 SUMを設定 rSum.fomulaR1C1 = " =SUM(R[-1]C:R[-" & rData.rows.Count & "])" ' 次のデータ範囲を取得 set rOrg = rOrg.Offset( rOrg.Rows.Count+1).Resize(1,1).CurrentRegion ' 取得した範囲の左上のセルが 空セルなら終了 loop while rOrg(1,1).Value = "" End Sub
お礼
redfox63さん、失礼しました。 誤って「この回答への補足」に入力してしまいまいした。 念のため「お礼内容」に同じ物を投稿しておきます。 どうぞよろしくお願いします。 --- redfox63さん、お返事が遅くなりすみません。 いただいたマクロを試したのですが、うまく動かず マクロの修正に四苦八苦しております。 勝手ながら一部を手直したところデータ群の一つ目は うまくsum関数を入力することができました。 ところが、データ群の2つ目に移動する ' 次のデータ範囲を取得 set rOrg = rOrg.Offset( rOrg.Rows.Count+1).Resize(1,1).CurrentRegion ここに問題があるようで、連続処理がうまくいきません。 rOrg+1でoffsetさせると次のデータ群の先頭部にはならないようなので、 rOrg部分を、rSumにしてみましたが、うまくいきませんでした。 さらなるお知恵をお借りできますと幸いです。 以下、手を加えさせていただいたマクロ内容です。 Sub Test_Macro1() Dim rOrg As Range, rData As Range, rSum As Range 'データ範囲を取得 Set rOrg = ActiveSheet.Range("A1").CurrentRegion Do ' 取得範囲が2行以下なら処理中断 If rOrg.Rows.Count < 2 Then Exit Do End If ' 取得範囲からデータ領域のみを抽出 Set rData = rOrg.Offset(1).Resize(rOrg.Rows.Count - 1) '合計行があるなら 1行マイナス 無ければ『合計』を転記 If rData(rData.Rows.Count, 2) = "合計" Then Set rData = rData.Resize(rData.Rows.Count - 1) Else rData.Offset(rData.Rows.Count, 1).Resize(1, 1).Value = "合計" End If ' 合計の数式範囲を設定 Set rSum = rData.Offset(rData.Rows.Count, 2).Resize(1, 3) ' 数式 SUMを設定 rSum.FormulaR1C1 = "=SUM(R[-1]C:R[-" & rData.Rows.Count & "]C)" ' 次のデータ範囲を取得 Set rOrg = rOrg.Offset(rOrg.Rows.Count + 1).Resize(1, 1).CurrentRegion ' 取得した範囲の左上のセルが 空セルなら終了 Loop While rOrg(1, 1).Value = "" End Sub
補足
redfox63さん、お返事が遅くなりすみません。 いただいたマクロを試したのですが、うまく動かず マクロの修正に四苦八苦しております。 勝手ながら一部を手直したところデータ群の一つ目は うまくsum関数を入力することができました。 ところが、データ群の2つ目に移動する ' 次のデータ範囲を取得 set rOrg = rOrg.Offset( rOrg.Rows.Count+1).Resize(1,1).CurrentRegion ここに問題があるようで、連続処理がうまくいきません。 rOrg+1でoffsetさせると次のデータ群の先頭部にはならないようなので、 rOrg部分を、rSumにしてみましたが、うまくいきませんでした。 さらなるお知恵をお借りできますと幸いです。 以下、手を加えさせていただいたマクロ内容です。 Sub Test_Macro1() Dim rOrg As Range, rData As Range, rSum As Range 'データ範囲を取得 Set rOrg = ActiveSheet.Range("A1").CurrentRegion Do ' 取得範囲が2行以下なら処理中断 If rOrg.Rows.Count < 2 Then Exit Do End If ' 取得範囲からデータ領域のみを抽出 Set rData = rOrg.Offset(1).Resize(rOrg.Rows.Count - 1) '合計行があるなら 1行マイナス 無ければ『合計』を転記 If rData(rData.Rows.Count, 2) = "合計" Then Set rData = rData.Resize(rData.Rows.Count - 1) Else rData.Offset(rData.Rows.Count, 1).Resize(1, 1).Value = "合計" End If ' 合計の数式範囲を設定 Set rSum = rData.Offset(rData.Rows.Count, 2).Resize(1, 3) ' 数式 SUMを設定 rSum.FormulaR1C1 = "=SUM(R[-1]C:R[-" & rData.Rows.Count & "]C)" ' 次のデータ範囲を取得 Set rOrg = rOrg.Offset(rOrg.Rows.Count + 1).Resize(1, 1).CurrentRegion ' 取得した範囲の左上のセルが 空セルなら終了 Loop While rOrg(1, 1).Value = "" End Sub
- n-jun
- ベストアンサー率33% (959/2873)
”合計”という文字が既に入っているのであれば、Findで探すってのもありなのかも。 Sheetをまたぐは#1さんの方法に一票で。 ただしSheetに対してRangeの与え方をミスると、ActiveSheetに固定されますから、気をつけて下さい。
お礼
n-junさんへ すばやくご回答いただいたのに、お返事が遅くなりました。 どうもすみません。 ご指摘の合計をfindするのも、よいアイデアだと思います。 とはいえ、書き漏らしましたが、合算部分と合計の記入は マクロで処理する予定でした。 また、Activesheetに固定される件の情報をいただき、 どうもありがとうございます。こういった部分で、 いちいち引っかかっている状態なのでありがたいです。 もろもろありがとうございました。
- tossy005
- ベストアンサー率38% (7/18)
データ群同士の間に1行あいているルールがあるならば、 空白行であり、かつ2行以上空白行が続いていない行に対し合計を埋め込めばよいと思います。 または、ご使用されているmy_last_row = Range("D65536").End(xlUp).RowのRangeを前回合計を埋め込んだセルからD65536までに変更し、前回合計を埋め込んだセルが返ってくるまで繰り返すか。 シートをまたぐのは、 Dim xlsheet as worksheet for each xlsheet In Worksheets 'シート毎の処理 next という感じでできると思います。
お礼
tossy005さま すばやいご回答どうもありがとうございました。 とてもよいヒントになりました。 いただいた内容を元にして自分でも試行してみます。 追伸 ほかのみなさまも、ぜひお知恵をお貸しください。
関連するQ&A
- エクセルvbaのワークシート関数について
テキストなどでvbaのワークシート関数を使うとき下の二つのコード のようにつかいなさい、と書かれていますが、両方同じように使って いいのでしょうか?実行結果は、ちがいますが。 Range("E3:E6").FormulaLocal = "=SUM(C3:D3)" Range("C6:D6").FormulaLocal = "=SUM(C3:C5)" 商品 上半期 下半期 合計 りんご 30 65 95 みかん 10 68 78 バナナ 30 65 95 合計 70 198 268 Range("E3:E6").FormulaLocal = WorksheetFunction.Sum(Range("C3:D3")) Range("C6:D6").FormulaLocal = WorksheetFunction.Sum(Range("C3:c5")) 商品 上半期 下半期 合計 りんご 30 65 95 みかん 10 68 95 バナナ 30 65 95 合計 70 70 95
- ベストアンサー
- その他(プログラミング・開発)
- EXCEL VBA 他のワークシートのデータを見るには?
EXCEL VBAでsheet1のセルに何かデータが入力された時に、sheet2のどこかのセルに同じ文字列がないかを探したいと思います。 データの入力と同時に検索をかけるため、sheet1の部分にイベントプロシージャを定義し、 データが入力された時にそのルーチンの中からsheet2のデータを見に行きたいのですが、エラーが出てしまいます。 こういうことはできないのでしょうか? Private Sub Worksheet_Change(ByVal Target As Range) Dim LineNo As Integer Dim tmp_str As String tmp_str = Target.Value LineNo = Sheets("sheet2").Cells.Find(what:=tmp_str, lookat:=xlWhole).Row MsgBox (LineNo) End Sub
- ベストアンサー
- オフィス系ソフト
- 【エクセル】 VBAでエラーが出てわかりません。。
やりたいことは、関数をマクロでセルに記入してオートフィルで指定した行数まで伸ばしたいのです。 (すでに関数で作成したファイルがあるのですが、行数が多いため、とても重い。。^^;) まずマクロの記録で次のマクロを取得しました。 Sub Macro4() Range("C4").Select ActiveCell.Formula = "=SUM(A2:A10)" Range("C4").Select Selection.AutoFill Destination:=Range("C4:C12"), Type:=xlFillDefault Range("C4:C12").Select Range("D11").Select End Sub そして、 Sheet2に貼り付けて > ActiveCell.Formula = "=SUM(A2:A10)" の"=SUM(A2:A10)"部分をちょっと長い関数ですが、 "=IF(ISERROR(INDEX(Sheet1!$I$1:Sheet1!$I$400,SMALL($A$2:$A$400,ROW(A1)),1)),"",INDEX(Sheet1!$I$1:Sheet1!$I$400,SMALL($A$2:$A$400,ROW(A1)),1))" と書き換えてマクロを実行すると「アプリケーション定義またはオブジェクト定義エラーです。」 というエラーが出てしまうんですが、どこを直せばわからないです。。 おかしいところを教えてください、よろしくお願いします。 わかり図らい説明かと思いますが。。この件(1行目の文)について似たようなことを解説して いるサイトがありましたら、教えて欲しいです。
- ベストアンサー
- 筆まめ・はがき作成
- エクセルのデータの合計
教えてください。 sheet1のセル、A1~A5のデータの合計を、sheet2のセルA1にSUM関数を使って、表示させてます。 次に、sheet1のセルA6~A10に入力されているデータの 合計をsheet2のセルA2に表示させたいのですが、 この際、sheet2のセルA1から、計算式を下にコピーすると、 sheet1のセルA2~A6の合計データが表示されます。 sheet1の5つのセルの各合計を、sheet2のセルに順番にコピーを使って表示させるには、どうしたらいいのでしょうか? うまく質問できていないかもしれませんが、 教えてください。
- 締切済み
- オフィス系ソフト
- エクセルVBAにてA列の数字の合計をA列のラスト行に入力したい。
お世話になります。 表題通りです。 エクセルにてセルのA.1~2・3と順番に数字が入っています。但し、終わりが決まっていません。 このA列のデータの入っていないセルにA列の合計を自動で入れたいのですが、 Range("A100").End(xlUp).Offset.Select ラスト行のセルを所得して、このセルにSUM(上)を入れたいのですが、 どのように書けばよいか教えて下さい。宜しくお願い致します。
- ベストアンサー
- オフィス系ソフト
- 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
- ベストアンサー
- Visual Basic
- エクセル VBAで検索したセルアドレスを、VBA内の式に組み込む方法
こんにちは。大変お世話になっています。 あるエクセルシートの中から対象セルをfindを使って検索しました。 Set td = Range("a2:bd35").Find(ymd) これで出たセル番地 td のひとつ右のセルに, 別のシートからデータを入れたいのですが、どうしてもうまくいきません。 Range(td.Address).Offset(0, 1).Select = Worksheets("入力").Range("b3") どのようにしたら良いのでしょうか? どうぞよろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- VBA 可変行のデータを自動集計する
vbaでシステムの効率化をしている エンジニアです。 添付の図のような表に100件~1000件 の可変するデータが入ります。 右の4つのコミッションを合計して小計のところに自動計算したいのですが データ量が変動するため(この表の上下のデータ量も変動する) vbaで何行目から何行目を合計するという指定ができません Q&Aを見ていくと offset関数・名前の定義をうまく使ったらいいとあり Worksheets("Sheet1").Names.Add Name:="名前A" RefersTo:=Range("コミッション1") Worksheets("Sheet1").Names.Add Name:="名前B" RefersTo:=Range("(2)小計") ActiveCell.Offset(-3, 2).Range("名前A:名前B").Select ActiveCell.Offset(15, 2).Range("名前A").Activate ActiveCell.FormulaR1C1 = "=SUM(R[-18]C:R[-1]C)" ActiveCell.Offset(-18, 0).Range("名前A:名前B").Select End If これで合計できると思うのですが、 どなたか添削していただけないでしょうか?
- ベストアンサー
- Microsoft ASP
- 串刺し関数でフィルの連続データ処理ができない
質問です。 年度ごとのシートに記載してあるデータを合計シートを作って5年分まとめようとしたのですが、一つのセルについてはΣで5年分できたものの、他のセルにフィルを使ってコピーできません。 具体的には以下の通りです。 1. "H17"から"H21"までのシートの"B4"セルの合計を、"トータル"シート"B4"セルに"=SUM('H17:H21'!B4)"と入力し合計を算出 2. "C4"セル以降もフィルを使って同様に計算させたいのですが、「連続データ」ではなく、「コピー」しかできず、同じ数値("=SUM('H17:H21'!B4)が羅列される。 ※右クリックしてフィルをつかっても「連続データ」は薄くなって使えない セルが多く、いちいち入力するわけにはいかないので、解決法をご教授ください。 よろしくお願いします。
- ベストアンサー
- その他MS Office製品
- VBA 配列とワークシートどっちがいい?
数値計算するマクロを作っていて思うことがあり質問しました。 ワークシートに3万セルのデータがあり、それを元に計算し、結果を別シートに記入します。 (1)計算をすべてワークシート上で行う方法 (2)データを全て配列に読み込み、配列上で計算し、結果のみ配列に書き出す方法 どちらがいいの? 考えや情報が色々と頭の中でぐるぐる回ってます。 ・せっかくの「表計算」ソフトなのだから当然(1)? ・シート上の方が色々な関数を使える ・配列上の方が計算速いと聞く ・3万セルごときどちらも同じ? ・10万セルの配列読み込み11秒(For Next)2秒(Range型変数使用)の書籍記事 ・100万セルの配列読み込みコンマ数秒(For Next)コンマゼロ数秒(Range型)のweb上記事 今まで私自身が体感したのは、例え3万個といえど ・行削除が多いと遅い ・コピペが多いと遅い(5千回で10秒) ・ファイル数が多いと遅い(open/close1個1秒弱) ・シート上だと関数はやっぱり豊富 ・セルへのアクセスは不明?? どっちがいいですか?100万セルでも同じですか? どっちでやってますか?
- ベストアンサー
- Excel(エクセル)
お礼
n-junさま 回答をどうもありがとうございました。 マクロは正しく動作しました。どうもありがとうございました。 マクロ自体は問題なく動くので、まったく問題ないのですが、 理解を進めたいため、ひとつ質問させてください。 マクロの流れは、理解したつもりなのですが、 If .UsedRange.Cells.Count < 2 Then ここのcountがなぜ<2なのでしょうか? UsedRangeが2以下、つまり1個という状態がうまく理解できません。 つまり、私が言っているような空シート、n-junさまの言われる 「空シートとはデータが一切ない物とします。(項目行を含め、何もない状態)」の状態で、 cells.countすると、UsedRangeが1になるということですか? 私の考えではcells.countしても、データがないので「0」になる。 なので、 If .UsedRange.Cells.Count < 1 Then でもいいように感じています。 そこで、実際に1にしてマクロを実行すると Set r = Intersect(.UsedRange.SpecialCells(xlTextValues), .Range("B:B")) でエラーになります。 このあたりで意味が分からなくなります。 お時間あればご教授ください。 よろしくお願いします。