行追加のInsertメソッドがひたすらに遅くなっていく件について[VBA]

2022-02-15
Office

私が作成したマクロに90秒かかるマクロがありました。調べてみたら85秒はInsertが原因でした。


今回はこのメソッドがどれくらい遅いのか、他のメソッドで代用したら早くなるのか、ということを検証していきたいと思います。

2022/2/21追記：

2022/2/16のアップデート、バージョン 2201 (ビルド 14827.20198)にてこちらのメモリリークするバグは修正されました。

もしこちらの事象が発生しているようでしたら、バージョン 2201 (ビルド 14827.20198)以上のバージョンにアップデートしてください。

管理人代理
管理人代理

Officeのバージョンをダウングレードすることでメモリリークが再現することを確認済み

このアップデートにより、10回連続で10000行Insertの処理を行っても3秒代から処理時間が増えることはなくなりました。

一応それでもまだInsertを使うよりも他の処理で代用した方が若干ですが早くなるので、さらに細かくチューンナップをしたいのであれば下記の処理を参考にしていただければと思います。

目次

Insertにどれくらい時間がかかるのか検証する

Sub insert()
    Application.ScreenUpdating = False
    Application.Calculation = xlManual

    Worksheets(1).Copy after:=Worksheets(1)

    starttime = Timer
    
    For i = 2 To 10000
        Worksheets(2).Rows(i).insert
    Next

    endtime = Timer

    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True

    MsgBox Str(Round(endtime - starttime, 1)) + "秒経過"

End Sub

まずは本当にInsertが遅いのか調べなきゃダメでしょう、というわけでこちらのコードを。

10000行Insertするロジックです。
というわけで実行ー！！

……え？

上司
上司

いや普通に早くない？

いやいや、そんなはずが…気を取り直してもう一度。

実行、実行実行ーーー。

管理人代理
管理人代理

ほら、90秒かかるようになりましたよ！！

上司
上司

メモリリークしてるじゃないか……。

はて。

メモリリークとは何ぞや

メモリリークとは、コンピュータで実行中のプログラムが確保したメモリ領域の解放を忘れたまま放置してしまうこと。動作の不具合を招くバグ（欠陥）の一種。

IT用語辞典 e-Wordsより引用

簡単に言うと、プログラムの実行に必要な領域をお掃除していないから、実行するごとに領域が少なくなっていって、実行時間が遅くなっていくという負のスパイラルが発生している状態です。

C#だと「ガベージコレクション」とかいうメモリリークの対処法があるのですが、VBAでメモリリークしてしまうと正直お手上げです。

管理人代理
管理人代理

ちなみにこの検証はちょっとだけいいパソコンでやっているので、普通の仕事用のパソコンだとメモリが少なくてもっと遅くなります…。

本当にメモリリークしているかの追加検証

パフォーマンス モニターを起動します。 次のカウンターを追加します。

Process–>Private Bytes (調査するプロセスごとに)

Process–>Virtual Bytes (調査するプロセスごとに)

Microsoftより引用

Microsoftの公式にパフォーマンスモニタを使用したメモリリークの検出方法も載っていたのでこちらの実行結果も貼っておきます。

Virtual Bytesが全然入りきる値じゃなかったせいでスケールが大変なことになっていますがそれは置いといて。

見る人が見ればこのグラフだけで「あー……」となると思いますが、一応解説をしておきます。
このグラフは縦軸が使用量で横軸が時間を表しています。

図中黄緑色の線がPrivate Bytesで赤色の線がCPU使用率になります。
青色の線はVirtual Bytesですが、今回は極めて変動が少ないのでこちらは使用しません。

13:54:35までの間にマクロを7回流しています。赤のCPU使用率が1000を越している部分がマクロを実行している時間帯です。
この赤い線、谷になるまでの時間がだんだん横に伸びていっていることがわかるかと思います。(つまり実行時間が伸びていっている)

黄緑の線も実行を重ねるごとに上がっていっていることが分かります。
マクロ終了と同時に下がる気配もありません。
このことからメモリリークをしているという結果が得られます。

13:54:35以降、放置したらExcelが自然にメモリ解放してくれないかなと思って少し様子見をしています。

13:55:15ごろに緑色の線がガクッと下がったので、メモリが解放されて処理時間が短くなるかなと思い、マクロを再度実行。
しかし処理時間がさらに延びるという結果に……。
メモリの使用量も実行開始と同時に元に戻ってしまっています。

13:57:30はExcelを立ち上げなおしました。
起動後はメモリは初期値まで下がり、起動一発目の処理時間も3秒でした。

そもそもInsertってなんで使っているんだっけ？

上司
上司

メモリリークしていることは分かった

はい。メモリリークしていることは分かりました。
ただ現状、ただのOfficeユーザーとしてはどうしようもないので、建設的に他の対処法を考えましょう。

Insertがメモリリークによってだんだん遅くなっていくのは分かっていても、それでもInsertを使って行いたい何かがあるはず。
というわけでInsertを使うことによって何をしたいのか、普通に上から順に処理するのではダメなのか考えてみました。

  1. 純粋に処理として空白行を間に挟みたい
  2. 書式設定を引継いだセルで作業したい
  3. 印刷の範囲を一緒に広げておきたい

現状、考えられるのはこの3点ですね。

これらの処理をInsertを使わずに実装すると実行に何秒かかるのか、計測してみましょう。

Insertを使わずに空白行を間に挟む

シートを追加して1行おきにデータを入れていきます。

Sub insert()
    Application.ScreenUpdating = False
    Application.Calculation = xlManual

    Worksheets.Add after:=Worksheets(1)

    starttime = Timer
    
    For i = 1 To 10000
        For j = 1 To 100
                Worksheets(2).Cells(i * 2, j) = Worksheets(1).Cells(i, j)
        Next
    Next

    endtime = Timer

    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True

    MsgBox Str(Round(endtime - starttime, 1)) + "秒経過"

End Sub

こんな感じ。

実行結果は……、

上司
上司

そんなに早くないね……

まあまあ、ちょっとお待ちください。

Private Const tate = 10000
Private Const yoko = 100

Sub insert()
    Application.ScreenUpdating = False
    Application.Calculation = xlManual

    Worksheets.Add after:=Worksheets(1)

    starttime = Timer
    
    Dim inLists As Variant
    Dim outLists(1 To tate * 2, 1 To yoko) As String
    
    Worksheets(1).Select
    inLists = Worksheets(1).Range(Cells(1, 1), Cells(tate, yoko))
    
    For i = 1 To tate
        For j = 1 To yoko
            outLists(i * 2, j) = inLists(i, j)
        Next
    Next
    
    Worksheets(2).Select
    Range("A1").Resize(tate * 2, yoko) = outLists
    
    endtime = Timer

    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True

    MsgBox Str(Round(endtime - starttime, 1)) + "秒経過"

End Sub

ソースをこのように修正してみました。

上司
上司

少しコードが長くなったね。

長くはなりました。けど効果は劇的なはず……!!

見よ、この結果！

実はVBAってシートにアクセスするのがメチャクチャ遅いので思い切って配列として処理した方が早くなります。
こちらのコードはなんと10回マクロを動かしても処理時間が全く変わりませんでした。

Insertを使わずに書式設定を引継ぐ

こちらは1行1行処理する方法と全行まとめて処理する方法があります。
処理に合わせて使い分けましょう。

もちろん、全行まとめて処理する方が早く処理は終わります。

全行まとめて処理

Private Const tate = 10000
Private Const yoko = 100

Sub insert()
    Application.ScreenUpdating = False
    Application.Calculation = xlManual

    Worksheets(1).Copy after:=Worksheets(1)

    starttime = Timer

    Worksheets(2).Range(Cells(1, 1), Cells(1, yoko)).Copy
    Worksheets(2).Range(Cells(2, 1), Cells(tate, yoko)).PasteSpecial (xlPasteFormats)
    Application.CutCopyMode = False
    
    endtime = Timer

    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True

    MsgBox Str(Round(endtime - starttime, 1)) + "秒経過"

End Sub

0.2秒という優秀な結果が得られました。

1行ごとに処理

Private Const tate = 10000
Private Const yoko = 100

Sub insert()
    Application.ScreenUpdating = False
    Application.Calculation = xlManual

    Worksheets(1).Copy after:=Worksheets(1)

    starttime = Timer
    
    For i = 1 To tate
        Worksheets(2).Range(Cells(1, 1), Cells(1, yoko)).Copy
        Worksheets(2).Range(Cells(i, 1), Cells(i, yoko)).PasteSpecial (xlPasteFormats)
        Application.CutCopyMode = False
    Next
    
    endtime = Timer

    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True

    MsgBox Str(Round(endtime - starttime, 1)) + "秒経過"

End Sub

やっぱり1行ごとで処理を行うと時間がかかってしまいます。

どうしても1行ごとに処理したいのであれば、

  1. 最初にまとめて書式設定をする
  2. 部分的に書式を変えたい部分は条件分岐で書式設定に追加していく

とか

  1. 10行ごと書式設定を行う
  2. 最後に余った行を削除する

とか、ループの回数を減らす工夫をしていくと処理速度向上につながりますよ。

Insertを使わずに印刷の範囲広げる

これは流石に一行一行絶対に処理しないといけないという状況はないと思います。
というわけでこちらのコードをご用意いたしました。

Private Const tate = 10000
Private Const yoko = 100

Sub insert()
    Application.ScreenUpdating = False
    Application.Calculation = xlManual

    Worksheets(1).Copy after:=Worksheets(1)

    starttime = Timer
    
    ActiveSheet.PageSetup.PrintArea = Range(Cells(1, 1), Cells(tate, yoko)).Address
    
    endtime = Timer

    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True

    MsgBox Str(Round(endtime - starttime, 1)) + "秒経過"

End Sub

とうとうカンマ秒も表示されなくなりました。劇的に早いです。