[[20210704110001]] 『同じマクロで実行速度に差が生じる』(日曜VBA) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『同じマクロで実行速度に差が生じる』(日曜VBA)

 同じマクロをマクロの表示(Alt+F8)から実行した場合と、
 プロシージャ上でsub/ユーザーフォームの実行(F5)した場合とでマクロ完了時間に差が生じます。
 大体以下の時間が掛かります。
 Alt+F8・・・5.67sec
 F5・・・・・0.82sec
 実行するマクロはいくつかの短いプロシージャを、まとめて実行するものです。

 質問したい点は、
 1)何故、実行時間に差が生じるのか?
 2)その原因は何か?(可能性があるもので構いません)

 ループ処理が多いと遅くなる等、Web上の記事で見たのですが、
 同じマクロで差が生じる事の説明にはならないと判断し、質問した次第です。
 何かご存じの方がいらっしゃいましたら、ご教授いただければ幸いです。

< 使用 Excel:Excel2016、使用 OS:Windows10 >


所々に、Debug.Print now() を入れて、
イミディエイトウィンドウで確認し、
Alt+F8 の時に時間を要しているところが
ないか調べてみると良いです。

ただ、そうやって調べようとすると
何故か再現しない(直ぐ完了する)という
ことも多々ありますけどね。
(AddinBox_角田) 2021/07/04(日) 11:56


 >AddinBox_角田さん
 アドバイス頂き、ありがとうございます。
 問題の切り分けをして、時間を要しているプロシージャを特定する事ができました。
 それが以下のものになります。

 Sub Sample()

  Dim iRng As Range
  With Cells(1, 1).CurrentRegion
    Set iRng = .Resize(.Rows.Count - 3, .Columns.Count - 3).Offset(3, 3)
  End With
  Dim Rng As Range
  For Each Rng In iRng
    If Rng.Value = "Day" Then Rng.Value = ""
  Next
  Set iRng = Nothing
  Set Rng = Nothing

 End Sub

 For Each のところで時間が掛かっていました。
 今回のセル範囲の合計は 78R*31C です。
 時間の計測の為、何度か試行してるうち Alt+F8 でも1秒程度で終わる時もあったり、
 そうかと思えば、また6秒程度掛る状態に戻ったり・・・
 F5での試行はずっと1秒程度を維持しておりました。

 改めて追加質問として、上記コードの改善点をご指摘いただける方がございましたら、
 ご教授の程、よろしくお願い致します。

(日曜VBA) 2021/07/04(日) 15:32


 コードについては、Replace を使えば良い事に気づきました。。。
 お目汚しすみません。

(日曜VBA) 2021/07/04(日) 15:49


解決されてるかもしれませんが気になったので一言

シートを直接書き換えるのではなく
一旦配列に置き換えて編集して
最後に一括でシートに格納すると速いと思います
(わんこ) 2021/07/06(火) 14:01


 >わんこさん
 アドバイスありがとうございます。
 今回のコードは下記の様に修正して時間短縮しました。

 Sub Test1()

    With Cells(1, 1).CurrentRegion
      .Resize(.Rows.Count - 3, .Columns.Count - 3).Offset(3, 3).Replace What:="Day", Replacement:="", LookAt:=xlWhole
    End With

 End Sub

 アドバイス頂いた配列の置き換えは、以下の様な感じでしょうか?
 配列内をループで総当たりする方法で良いのかご教示いただけますと幸いです。

 Sub Test2()

  Dim iRng As Range
  With Cells(1, 1).CurrentRegion
    Set iRng = .Resize(.Rows.Count - 3, .Columns.Count - 3).Offset(3, 3)
  End With
  Dim bufArr() As Variant
  bufArr = iRng
  Dim i As Long, j As Long
  For i = LBound(bufArr, 1) To UBound(bufArr, 1)
    For j = LBound(bufArr, 2) To UBound(bufArr, 2)
      bufArr(i, j) = Replace(bufArr(i, j), "Day", "")
    Next j
  Next i
  iRng = bufArr
  Set iRng = Nothing

 End Sub

(日曜VBA) 2021/07/06(火) 20:46


上記のコードで問題ないです。
あとは実行してみてどうなるかといったところですね。
(わんこ) 2021/07/07(水) 07:31

質問内容は別にして、提示されている内容(処理)については↓が参考になると思います。
[[20210620164819]] 『台という字でセル内で改行するコードをスピードアップさせるには』(正樹)

実際にReplaceメソッドによる一括処理と、一旦配列として取得して総当たりする方法のどちらが有利であるかは、とても興味があるところなので是非とも結果を知りたいところですがそれはそれとして、対象のセル範囲を求める↓の部分について

    With Cells(1, 1).CurrentRegion
      .Resize(.Rows.Count - 3, .Columns.Count - 3).Offset(3, 3)〜
    End With

Intersectメソッドを使えば、「○○.Count - 3」は要らないと思いますがいかがでしょうか?

 Sub Test1_改造()
    Dim MyRNG As Range

    With ActiveSheet.Range("A1").CurrentRegion
      Set MyRNG = Intersect(.Cells, .Offset(3, 3))
    End With

    If Not MyRNG Is Nothing Then MyRNG.Replace What:="Day", Replacement:="", LookAt:=xlWhole
 End Sub

(もこな2) 2021/07/07(水) 13:03


 >もこな2さん
 アドバイスありがとうございます。
 恥ずかしながら、Intersectメソッドを存じておりませんでした。
 まさに希望通りの結果となり、大いに参考になりました。
 重ねてお礼申し上げます。

 Replaceと配列の両方で3回ずつ試行した結果は、今回のケースでは以下の結果になりました。

 -- Replace --
 0.8046875 sec
 -- Replace --
 0.8125 sec
 -- Replace --
 0.796875 sec
 --- Array ---
 0.8046875 sec
 --- Array ---
 0.8125 sec
 --- Array ---
 0.8046875 sec

 当初の質問である Alt+F8 と F5 の速度差は、コード訂正後ほぼ無くなり、
 無駄に時間が掛かる記述だったのだと勝手に納得しています。

 >わんこさん
 返信が前後してすみません。
 今まで二次元配列を難しく感じており、
 セル範囲を配列に格納することを避けていたのですが、
 今回アドバイス頂いたことで、理解しようと取り組むきっかけになりました。
 少しですが理解できたような気もします。
 ありがとうございました。

(日曜VBA) 2021/07/07(水) 19:51


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.