• ベストアンサー
※ ChatGPTを利用し、要約された質問です(原文:Excel Slope関数 繰返し処理の簡略化)

Excel Slope関数の繰返し処理を簡略化する方法は?

このQ&Aのポイント
  • ExcelのSlope関数をVBAで繰返し処理させたいが、処理が遅くなる問題がある。特に、指定範囲のセルに対する処理が時間がかかるため、処理を軽くする方法を知りたい。
  • 質問者は自分のプログラムでSlope関数の繰返し処理を行っているが、Excelの動きが鈍いことに気付いた。問題の原因として、指定範囲のセルに対する処理が重い可能性がある。
  • 質問者はSlope関数をVBAで繰返し処理させるためのプログラムを作成したが、処理に時間がかかり、Excelの動きが鈍くなってしまう。処理が遅くなる部分を特定し、軽くする方法を教えて欲しい。

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

  • ベストアンサー
  • cj_mover
  • ベストアンサー率76% (292/381)
回答No.2

こんにちは。 数式を出力するもの、 値を出力するもの、 2例、挙げておきます。 1)遅くなる原因を十分に(未然に)(場合によっては必要以上に)排除しておく。 2)オブジェクトへの参照は必要最小限にして、繰り返さない。 3)計算を実行するタイミングを一度に纏める。 3)については、本来は配列変数を使って数式を一気に出力するのが有力ですが、 ここでは、数式の先頭に全角空白を付加した文字列を一旦出力して、 置換機能で全角空白を削除するタイミングで計算させます。 「数式を出力するもの」 現状問題の遅さ、についての手当てとしては、主に3)の効果が大きいと思いますが、 1)2)については、ExcelyaExcel VBAを扱う上では、一応基本的な手法ですので、 書き加えています。 「値を出力するもの」 出力する数式の参照先のデータが変動値ではなく、固定であるならば、 VBAで計算したものを値で出力することで、実行を軽くできますし、 ファイルそのものを軽くできます。 1)の記述は、元に戻す処理と対になっています。 他の処理を書き加える時は、エラーに備えて、確実に元に戻すように エラーを制御するよう検討してください。 この手のテーマは、方法を伝えるよりサンプルを示した方が 解り易いんじゃないかな、と思ったので、例示として以下を提示します。 ' ' 「数式を出力するもの Sub Re8344147f()   Dim rRef As Range   Dim n As Long   Dim i As Long   With Sheets("Sheet2")  '  2)     For i = 55 To .Cells(Rows.Count, 2).End(xlUp).Row       If .Cells(i, 2) >= 3 Then Exit For     Next i   End With   n = i - 2   With Application  '  1)     .Calculation = xlCalculationManual     .EnableEvents = False     .ScreenUpdating = False   End With   Set rRef = Range("A55:A" & n)  '  2)   With Worksheets("Sheet3").Range("Q16:Q28")  '  2)     For i = 1 To 13  '  3)↓       .Cells(i).Value = " =Slope(Sheet2!" & rRef.Offset(, i * 2).Address(0, 0) & ",Sheet2!" & rRef.Offset(, i * 2 - 1).Address(0, 0) & ")"     Next i     .Replace " ", ""  '  3)   End With   Set rRef = Nothing   With Application  '  1)     .Calculation = xlCalculationAutomatic     .EnableEvents = True     .ScreenUpdating = True   End With End Sub ' ' 「値を出力するもの」 Sub Re8344147v()   Dim rRef As Range   Dim n As Long   Dim i As Long   With Sheets("Sheet2")  '  2)     For i = 55 To .Cells(Rows.Count, 2).End(xlUp).Row       If .Cells(i, 2) >= 3 Then Exit For     Next i   End With   n = i - 2   With Application  '  1)     .Calculation = xlCalculationManual     .EnableEvents = False     .ScreenUpdating = False   End With   Set rRef = Sheets("Sheet2").Range("A55:A" & n)  '  2)   With Worksheets("Sheet3").Range("Q16:Q28")  '  2)     For i = 1 To 13       .Cells(i).Value = Application.Slope(rRef.Offset(, i * 2), rRef.Offset(, i * 2 - 1))     Next i   End With   Set rRef = Nothing   With Application  '  1)     .Calculation = xlCalculationAutomatic     .EnableEvents = True     .ScreenUpdating = True   End With End Sub

cheesepizza
質問者

お礼

ご回答ありがとうございました。 サンプル構文の提示もありがとうございました。 ' ' 「数式を出力するもの で記載して頂いたマクロを自分のExcelファイルに貼り付けて、一部変更して使用したところ今までのマクロの3倍くらい速い速度で処理できました。 しかし、まだマクロ入門したばかりなので、この構文ですともし使用現場で何か不具合があった際に対応ができない懸念点が残ってしまいます。 ですので、せっかく教えて頂いたのですが、今までのマクロで職場の先輩に教えて頂いた内容を少し取り入れたもので運用したいと思います。 お忙しいところご回答いただきましてありがとうございました。

全文を見る
すると、全ての回答が全文表示されます。

その他の回答 (1)

回答No.1

「どれくらい」遅くなるかがかかれてないけど、とりあえずブックの自動再計算がオンなら、関数を挿入するたびに再計算されるので多少は遅くなるでしょうね。 一時的に自動再計算をオフにするか、もしくは「そもそもそのセルにSLOPE関数が必要なのか」を考え直すかです。 念のため説明。 「そもそもそのセルにSLOPE関数が必要なのか」というのは「そのセルに“関数が入っている必要”はあるのか」ということです。 もし結果がそのセルに入ればいいならわざわざSLOPE関数を入れるのではなくVBA内で計算してしまえばいいのですから。 関数をどうVBAで使うか知らないなら↓ https://www.google.co.jp/search?q=vba+worksheetfunction

全文を見る
すると、全ての回答が全文表示されます。

関連するQ&A

  • エクセルVBAで別範囲のセル書式設定を利用したいと思っています。

    エクセルVBAで別範囲のセル書式設定を利用したいと思っています。 最近、 Worksheets("Sheet2").Range("B1:B10").Formula = Worksheets("Sheet1").Range("B1:B10").Formula のような式を覚えたので、同じようにRangeを利用して別範囲の書式をコピーしたいと考えましたが、 .Formula に換えるプロパティがわかりません。 試しに .font.bold としても反応しませんでした。 Worksheets("Sheet1").Range("B1:B10").Copy Worksheets("Sheet2").Range("B1:b10").PasteSpecial Paste:=xlPasteFormats の2行より短くはならないのでしょうか? 宜しくお願いします

  • [エクセル]VBA連続処理を途中でストップさせたい

    [エクセル]VBAの連続処理を途中で自動的にストップさせるには? 以前にこちらで下記の質問をさせて頂きました。 http://okwave.jp/qa/q3838337.html 最終的にNo.4の回答がベストアンサーとなりました。 ---------- Sub kaiseki() For i = 0 To 9 Sheets("Aシート").Select If Range("B3").Offset(i, 0).Value = Empty Then GoTo Skip Worksheets("Bシート").Range("B11:G11").Value = Worksheets("Aシート").Range("B3:G3").Offset(i, 0).Value Worksheets("Bシート").Calculate Sheets("Aシート").Range("J3:O3").Offset(i, 0).Value = Worksheets("Bシート").Range("B15:G15").Value   '※元のマクロの19行まで   '※中略(ここの部分の処理も上を参考にすれば可能です) Skip: Next i End Sub ---------- 上記の場合はAシートの9行目(For i = 0 To 9)まで自動的に処理が進むのですが、AシートのB~Gのセルに数値が入っていなかった場合は、その行で処理をストップさせたいと思っています。 例えば、B~Gの3行目まで数値が入っていて、4行目には数値が入っていなかった場合、9行目まで処理を進めるのではなく、数値が入っていない4行目で処理を停止させたいです。 どのように記述を書き加えれば良いのでしょうか? 御教授を頂けると助かります。 よろしくお願い致します。

  • エクセル関数、変数の設定について

    あの~すみません。エクセル関数、変数の設定について教えてください。 「42」と言う数だけが「42」、「60」、「120」と日々変わります。 何回も書き換えるのは面倒なので変数として「セルのA1」に「42」、「60」、「120」、と書き換えることで下記の処理をしたいのですが、・・・ Sheet1に次の数式があります。 =SUMIF((INDIRECT($J$6)),"=1イ",INDIRECT($L6)) ($J$6)はSheet2!$C$5:$C$42です。 $L6は Sheet2!E$5:E$42 $L7は Sheet2!F$5:F$42 $L8は Sheet2!G$5:G$42 $L9は Sheet2!H$5:H$42 $L10は Sheet2!I$5:I$42 ・・・・・・・・・・・・・・・・・・・・・・ ・・・・・・・・・・・・・・・・・・・・・・ $L○○は Sheet2Z$5:Z$42 ご教授お願いします。

  • Excel VBAでの質問

    以前、質問に回答頂きそれを実行してうまくいったのですが、 特定のsheetだけsheetのつくりが違うため、 このsheetは毎回なにも処理をしないという処理を加えたいのですが、 (例えばsheet5とsheet8は処理をしない) 下記のコードにどのように付け加えればよいでしょうか? わかるかた宜しくお願い致します。 Dim i As Long For i = 1 To Worksheets.Count  If Worksheets(i).Range("A1").Value = 10 Then Worksheets(i).Range("K1") = Worksheets(i).Range("A1")  Worksheets(i).Range("A1:D80").ClearContents Next End Sub

  • excelのマクロでrangeの選択がうまくいきません。

    excelのマクロでrangeの選択がうまくいきません。 以下のマクロをsheet2に書きました。testcopyは動きますが、testcopy2は動きません。なぜなのでしょうか。どうすればいいのでしょうか。それ以外のマクロの部分との関係から、cellsを使い、数字を使ってrangeの処理をしたいのです。よろしくお願いします。 Sub testcopy() Worksheets("sheet1").Range("B3:C10").Copy Worksheets("sheet2").Range("e5").Select ActiveSheet.Paste End Sub Sub testcopy2() Worksheets("sheet1").Range(Cells(3, 2), Cells(10, 3)).Copy Worksheets("sheet2").Range("e5").Select ActiveSheet.Paste End Sub

  • マクロについて教えてください。

    最近、勉強し始めました。 名簿を作成しています。Sheet1のデータを2種類に分けてSheet2(県外)、Sheet3(県内)のあらかじめ作成している表に振り分けたいのです。 しかしながら、1名分のデータをコピーして張り付けることはしたのマクロで出来たのですが、2名分もこのようにするとなると手入力したほうが速いような気がしています。 なにかいい方法がありましたら教えてください。 Sub コピーして別のシートに貼り付ける1() Worksheets("Sheet1").Activate Range("B11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("B10:E17") Range("C11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("A18:E19") Range("D11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("F10:K17") Range("E11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("F18:K19") Range("F11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("M10:S10") Range("G11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("M11:S11") Range("H11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("M12:S12") Range("I11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("M13:S13") Range("J11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("M14:S14") Range("K11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("M15:S15") Range("L11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("M16:S16") Range("M11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("M17:S17") Range("N11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("M18:S18") Range("O11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("M19:S19") Range("P11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("T10:T19") Range("Q11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("U10:U19") Range("R11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("V10:V19") Range("S11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("W10:W19") Range("T11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("X10:X19") Range("U11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("Y10:Y19") Range("V11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("Z10:Z19") Range("W11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("AA10:AA19") Range("X11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("AB10:AB19") Range("Y11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("AC10:AG19") End Sub

  • エクセル マクロ IF関数について

    Sheet1にグループボックス内で、チェックボタンで項目を選択するとA1に記載されるように作成、マクロで入力ボタン作成しボタンをクリックするとSheet2に記載されるように作りました。しかし、項目が多いためSheet2を見るとABCDEFGなどの列に空白が目立ち使いづらいです。 そこでIF関数を使い何とか出来ないでしょうか? 例)SHEET1 B2に原因のグループボックスにカテゴリー(チェックボックスにて1)入力ミス、2)人、3)機械) B3に対応のグループボックスにカテゴリー(チェックボックスにて1)外注、2)修正、3)報告) と作り、それらがチェックされていたら、A1の列に表示され入力ボタンを押したら、Sheet2のAには原因、Bには対応と記載されるようにしたいです。その時Sheet1のA列に空白があれば、Sheet2の列に表示するようにしたいです。 実際のマクロ記入 Sub 入力() Dim LastRow As Long With Worksheets("Sheet2") LastRow = Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row + 1 .Range("A" & LastRow).Value = Worksheets("Sheet1").Range("A6").Value .Range("B" & LastRow).Value = Worksheets("Sheet1").Range("A7").Value .Range("C" & LastRow).Value = Worksheets("Sheet1").Range("A8").Value .Range("D" & LastRow).Value = Worksheets("Sheet1").Range("A9").Value .Range("E" & LastRow).Value = Worksheets("Sheet1").Range("A10").Value .Range("F" & LastRow).Value = Worksheets("Sheet1").Range("A12").Value .Range("G" & LastRow).Value = Worksheets("Sheet1").Range("A13").Value .Range("H" & LastRow).Value = Worksheets("Sheet1").Range("A15").Value .Range("I" & LastRow).Value = Worksheets("Sheet1").Range("A16").Value .Range("J" & LastRow).Value = Worksheets("Sheet1").Range("A19").Value End With End Sub お願いします教えてください。

  • エクセルVBAでコピーして 手動で貼り付け 

    こん○○は 初心者であちこちからコードをコピペしてなんとかつなぎ合わせているレベルです。 エクセル2002 OS XP Sub copy() i = Worksheets(3).Range("I2")      'I2に適当な数字が入ってる i = i + 1 左上 = "G1" '選択する範囲の左上セル 右下 = "H" & i '   〃   右下セル 範囲 = 左上 & ":" & 右下 Worksheets(3).Range(範囲).copy_ Worksheets(3).Range("n1").PasteSpecial Paste:=xlPasteValues i = (i + 1) / 2 左上2 = "N1" 右下2 = "O" & i 範囲2 = 左上2 & ":" & 右下2 Worksheets(3).Range(範囲2).copy End Sub というコードでコピーした状態にした後手動で他のエクセルやテキストに貼り付けようとしています。ただしシート3は Private Sub auto_Open() ActiveWorkbook.Unprotect Worksheets("Sheet1").Visible = False Worksheets("Sheet3").Visible = False ActiveWorkbook.Protect End Sub でみえなくしています。 こうすると他のエクセルに貼り付けると 貼り付け先のシートが消えてしまいます。消えないようにしたいのですが。 なんとかお知恵を拝借できませんでしょうか?よろしくお願いします。

  • for~Next 構文の間に処理を追加したい。

    for~Next 構文の間に処理を追加したい。 ちょっと必要に迫られまして、他人の作ったEXCELマクロをいじらないといけなくなったのですが、小生初心者でどうもうまくいきません。 sheet1に条件を入れて、sheet2のセルに表示された内容をラベルに印刷するというプログラムなのですが、 PrintColum = Worksheets("sheet1").Range("L5").Value MaxGyou = Worksheets("sheet1").Range("L4").Value Maxrow = Worksheets("sheet1").Range("B" & Rows.Count).End(xlUp).Row Gyou = 1 + Worksheets("sheet1").Range("A3").Value Keta = 1 Worksheets("sheet2").Activate For k = 5 To Maxrow Hiduke = Worksheets("sheet1").Range("A" & k).Value ID = Worksheets("sheet1").Range("B" & k).Value Koumoku = Worksheets("sheet1").Range("C" & k).Value Kishaku_Min = Worksheets("sheet1").Range("D" & k).Value Kishaku_Max = Worksheets("sheet1").Range("E" & k).Value Maisu = Worksheets("sheet1").Range("F" & k).Value blank = Worksheets("sheet1").Range("G" & k).Value For i = Kishaku_Max To Kishaku_Min Step -1 For j = 1 To Maisu Keta = Keta + 1 Worksheets("sheet2").Range("A1").Cells(Gyou, Keta + 1).Value = " " & Hiduke & " " & ID & Chr(10) & " " & Koumoku + " 10^" + CStr(i) GyouHyouji = Worksheets("sheet2").Range("A1").Cells(Gyou, 1).Row Worksheets("sheet2").Range("A1").Cells(Gyou, 1).Value = (GyouHyouji - 1) Mod MaxGyou + 1 If Keta > PrintColum Then Keta = 1 Gyou = Gyou + 1 End If Next j Next i Next k Next i の処理が終了したとき、blankの値が"1"なら、ひとつだけ内容の違うセルを差し込みたいと考えています。 わかる範囲でいろいろ試したのですが、まったくうまくいきません。 どなたかお知恵を拝借できないでしょうか?

  • Excel vba selectが効かない

    2と3の2つのエクセルファイルがあります。縦の列を新しいファイルの横の行に コピーしていきたいプログラムです。 2のファイルの1シート目の"C8:C25" 3のファイルの1シート目の"C9:C65" を新しい1のファイルの1シート目の1行目にコピーするプログラムを 作っていますが1シート目はpasteされるのですが 3のファイル2シート目からselectの指定が"C9:C65"ではなく、B9からQ65の指定になってしまい思ったコピーができません(★のところ)、1シート目はうまくいっているのでどうして3のファイルの2シート目のからうまくいかないかわかりません。 5シートまででテストをしているのですが実際は各々255シートありもってくる列も 12列あります。とりあえずCの列だけ5シートで試してみています。 Dim i As Long Dim N As Long i = 1 N = 1 Do While i <= 5 ''C列''' Workbooks(2).Worksheets(i).Activate   '2のファイル Worksheets(i).Range("C8:C25").Select   'もってくるところ Selection.Copy Workbooks(1).Worksheets(1).Activate   '1新しいファイル Range("C" & N).Select   '貼り付けるところ Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=True Workbooks(3).Worksheets(i).Activate   '3のファイル Workbooks(3).Worksheets(i).Range("C9:C65").Select  '★もってくるところ Selection.Copy Workbooks(1).Worksheets(1).Activate   '1新しいファイル Range("U" & N).Select   '貼り付けるところ Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=True i=i+1 N=N+1 LOOP