Excel VBA 行挿入の高速化

Question

タイトルの通り、行挿入の高速化方法について質問です。

Excelのシートに、仕様の一部として、例えばA列のセルにデータがある場合、その行に2行ずつ行追加しなければならないような処理を実現しなければならないのですが、レコード件数が多く、該当シートにはオートシェイプも多数存在しており、行挿入の処理でかなり処理時間がかかってしまいます。

現在はループでデータがある場合のみ２行挿入、という処理をしていますがデータ件数は常に同じではないので、大量のデータ(試しているのは200～300件、それ以上もありえる)だった場合に2分以上かかってしまい、全体の処理として4分以上かかってしまいます。

これを高速化する手段はありますでしょうか。
アドバイスや代替案などご教授お願い致します。

【参考:簡略した現在のコード】

Application.ScreenUpdating=False
Application.Calculation = xlManual

Dim i As Long
i=2
Do While i <> 最終行+1
  If Cells(i,1).Value <> "" Then
    Rows(i+1).Insert Shift:=xlDown
    Rows(i+1).Insert Shift:=xlDown
  End If
Loop

Application.Calculation = xlAutomatic
Application.ScreenUpdating=True

Answer 1

サンプルコードについて

記載いただいたソースは（おそらく簡略化した影響だと思いますが）iのインクリメントがなく無限ループにはまってしまいました。
また、最下行も行挿入するたびに+2ずつ増やしていく必要がありそうですが、これも簡略化してしまったためか、指定した最下行まで処理が回らないコードとなっているようです。

本題

さて、ここから本題です。

当方の環境で200行程度のテストデータを作成しサンプルコードを実行したところ、ものの数秒で処理終了しました。
オートシェイプも各行５つくらいずつ貼り付けておきましたが、サイズが小さすぎるのか、負荷とはならなかったようです。

というわけで、速度改善案となるかはわかりませんが、参考までにアドバイスさせていただきます。

---

まず行挿入や削除を行う処理を作成する場合、私なら最下行から処理を開始します。

サンプルコードをベースに改修するならこんなかんじです。

Dim sht As Worksheet
Set sht = Sheet1    '←対象シートを特定しないと、処理中にアクティブでなくなったときに異常動作の原因となります。

Application.ScreenUpdating = False
Application.Calculation = xlManual

Dim i As Long
i = 最下行
Do While i > 1
  If sht.Cells(i, 1).Value <> "" Then
    '2行は1回で挿入
    sht.Range(CStr(i + 1) & ":" & CStr(i + 2)).Insert Shift:=xlDown
  End If
  i = i - 1
Loop

Application.Calculation = xlAutomatic
Application.ScreenUpdating = True

わかりやすく小さなデータで説明すると、
今回の処理で2、3、4行目に対象データがあり、それぞれの下に２行ずつ行挿入することを考えます。

普通に上から順に処理していくと、
①2行目に対して3・4行目となる空行を挿入。
②5行目に対して6・7行目となる空行を挿入。
③8行目に対して9・10行目となる空行を挿入。
とう流れになります。

これを逆から行うと
①4行目に対して5・6行目となる空行を挿入。
②3行目に対して4・5行目となる空行を挿入。⇒4～6行目は6～8行目になる
③2行目に対して3・4行目となる空行を挿入。⇒3～8行目は5～10行目になる
となります。

どうでしょう？
上の行は、それ以降の行を追加・削除した影響で行番号がずれたりしないので、こちらの方が管理しやすくなると思います。

一括挿入も視野に入れられるのではないでしょうか？

参考になれば幸いです。

Comments

[DgRp_08]

アドバイスありがとうございました！
最下行からの一括挿入は試してみましたが、２行ずつ挿入よりも処理時間が遅くなってしまったので、今回は２行ずつ挿入の方法で対処しました！
下から挿入という考え方はすっかり失念していたので、大変参考になりました！
今後活かさせていただきたいと思います！
詳しく回答してください本当にありがとうございました！

Answer 2

ご提示頂いたコードを一部変更して500件ほどで試してみましたが、一瞬で行挿入が完了いたしました。
私が使用したソースは以下のものです。

Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    
    Dim i As Long
    Dim lngLastRow As Long
    
    lngLastRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    i = 2
    Do While i <> lngLastRow
      If Cells(i, 1).Value <> "" Then
        Rows(i + 1).Insert Shift:=xlDown
        Rows(i + 1).Insert Shift:=xlDown
      End If
      i = i + 1
      lngLastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Loop
    
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
        
    MsgBox ("完了しました。")
    
End Sub

データがあるのと同シート内にボタンを作って実施しました。
よって、行追加に時間がかかるというよりは、別のところに原因があるのではないかと思いました。

例えば改善案として、

案１
ご提示頂いたソースを見た限りですと自シート内にボタンがあるように思えますが、
もしソースがあるファイルと、データがあるファイルが別ならば同一ファイル内で実行してみる。
（これで早くなった場合は、別ファイル操作に問題があると言える）

案２
オートシェイプはただの画像貼り付けでしょうか。
もし、ご提示頂いたソース以外でオートシェイプ操作がありましたらそれを見直す。
（Selectの多使用は遅延の原因の１つです）

案３
これは難しいかもしれませんが、Excelのバージョンを変更することで早くなることがまれにあります。
（例：現在EXCEL2007をご使用ならEXCEL2010で試す）
私の環境は
・windows7
・Excel2010
となっております。

最後にすみません、質問なのですが、

大量のデータ(試しているのは200～300件、それ以上もありえる)だった場合に2分以上かかってしまい、全体の処理として4分以上かかってしまいます。

大量のデータだった場合に2分以上かかり、全体の処理として4分以上かかる、というのは大量のデータに改行を入れる以外に何か2分ほどの別な処理があるということでしょうか？

少しの修正で劇的によくなることがありますので、原因追究には根気が必要ですね＾＾；

Comments

[DgRp_08]

回答有り難うございます。

環境について記載を失念しておりました。申し訳ありません。
環境は以下のとおりです。

Windows 7
Excel 2010
Core i5
メモリ4G

コードの変更点についてですが、常に最終行を取得しておくという点でしょうか？

実行ボタンについては別シートにあります。
説明は省略していましたが、行追加する前のデータとしてAシートがあり、それをベースとして、「Aシートをコピーして、Bシートとする」ようにしています。
行追加処理対象はBシートです。

行追加した分、新たにオートシェイプを追加する処理があります。こちらに行追加以外で二分ほどかかっております。

スケジュール表作成ツールで、Aシートは予定日のスケジュールデータのみ、BシートはAシートの予定日＋実績日＋予備予定日のスケジュールデータとなります。
オートシェイプはそれをマイルストーン描画するために利用します。
また、その他コメントとしてユーザが手動で配置したオートシェイプもランダムに存在します。

さらに、実際には行追加だけではなく、罫線の設定も同じループ内でしております。

オートシェイプの操作については、大変複雑で、現在以上にいじるには大きなリスクがあります。
昔に他の方が実装した既存の処理なので、私がいじることができません。(触るなと言われている)
よって、新規に追加した行追加処理の部分をなんとかしたい所存です。

スマホからの投稿で、文章がわかりにくくなってるかもしれませんが、ご了承ください。

よろしくお願いいたします。

[SASAHARA]

詳細情報、ありがとうございます。
オートシェイプ操作２分、それ以外でおよそ２分という感じだったのですね。

まず、ご質問に回答させて頂きます。
>コードの変更点についてですが、常に最終行を取得しておくという点でしょうか？

回答でのコードは、DgRp_08さんのご提示頂いたコードを元に、必要と思われる情報を追加しました。
具体的には最終行の取得と、iの増加が足りていなかったのでそこを足して実行してみたものになります。
最終行を毎回追加した理由は、行挿入するたびに最終行が+2ずつ追加され変動するためです。変動を毎回把握しないと、現在の行(i)と最終行が一致したらループを抜ける、という処理が正しく行われないと思いましたのでこのように致しました。ご提示頂いたソースは略されていたのですがこのような処理があるかと推測して追加したのですが、違いましたでしょうか？色々勘違いしていたらすみません。
もし私が実際作成するなら、他の方もおっしゃっている通り下からのループを作成したのと思います（毎回最終行取得するのは効率悪そうなので）。今回はあくまでご提示頂いたソースでは行追加に２分もかからないと思います、ということをお伝えしたくこのように致しました。
初回の回答後にオートシェイプを2～3行に1つ入れた300行で実施してみましたが、やはり数秒で完了しました。

一連の流れをまとめますと、
①Ａシートにデータを貼り付ける
②実行ボタン押下（以下実行ボタン内の処理）
③ＡシートのデータをＢシートにコピー

-----　ここから下の処理はＢシートの処理　-------

④データがある行に+2行追加
⑤罫線の設定
⑥オートシェイプ処理

このような感じでしょうか。

上記であっている前提として、
③～⑤までで２分前後かかるということですね。
⑥は単体で２分ですが、これは修正不可ということなので置いておきます。

今回私が提示させて頂いた例は④のものですが、これはすぐに処理が完了したことを確認しました。
つまり、③か⑤に遅延の要因があるのではないかということを疑っているのですが、遅延の要因は④にあるということを確認されましたでしょうか？もし確認していたらすみません。余計なことを言っていると思いますので私の回答はスルーして頂ければと思います。

　頂いた情報から少々疑わしいと思ったのは
>さらに、実際には行追加だけではなく、罫線の設定も同じループ内でしております。

罫線はループを抜けた後にまとめてやる方が軽く済むのではないかと思いました。

以上、参考になれば幸いです。

[退会済みユーザー]

横入り失礼します。

DgRp_08様

マクロ実行が遅い原因、上記コメントで分かりましたが…解決できるかは別問題です。

上記ハードスペックでは、「メモリ4GB」とございますので、おそらくは
Windows7自体も立ち上げに時間がかかっているのでは?と推測できます。

他の方々は、メモリ8GB～16GB程度を搭載しておられると考えられますので、
出来ればメモリの増設をお勧めします。

ただ、会社所有のPCの場合、
1.情報管理部門への申請や許可の上で行なう必要がございます。
2.構成情報が変更になるので、OSの再インストール等が必要な場合があります。
という点が重要になりますので…。

[DgRp_08]

回答ありがとうございました。
お粗末な省略コードでわかりづらくなってしまい申し訳ありませんでした。
必要な値のインクリメントや最終行の確保などは実際には実装済みでした。
また、PCはお客様から貸し出されているPCの為、環境の変更は不可能でした。
結局、解決としては２行ずつ行挿入することで短縮することができました。
あらゆる観点からアドバイスいただき本当にありがとうございました。
今後に活かせていただきたいと思います！

Answer 3

VBA を使うときは
・画面の更新を停止する
・自動再計算を停止する
ということをいつもやっています。

下記サイトが参考になります。
VBAシステム開発: 2.6.3 画面描画と数式再計算を止める

紹介したサイトにも書いてありますが、
停止させたものは元に戻す必要があるのでご注意ください。

---

上記の対策は最初におこなわれていましたね。
申し訳ありませんでした。

Insert を 1 回だけ呼ぶようにするだけでも
だいぶ変わるんじゃないでしょうか。
サンプルコードを下記に掲載します。

Sub test()
    Dim i As Long
    Dim r As Long
    Const 追加行数 As Long = 4
    r = Range("A" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
    For i = r To 2 Step -1
        If Range("A" & i).Value <> "" Then
            Range("A" & i + 1).Resize(追加行数).EntireRow.Insert
        End If
    Next
    Application.ScreenUpdating = True
 End Sub

---

他にも Range による飛び飛びの行を複数指定することで一度に挿入することもできます。
例えば次のようなコードになります。

Range("2:3,6:7").Insert

kpiyohiko さんへのコメントで、指定数に上限があったり、
処理を分けると行情報がずれてしまったりなど問題があるとのことですが、
行を挿入する処理を最下行からおこなえば
行情報がずれることはないと思うので、
その問題に関しては工夫次第でなんとかなると思います。

Comments

[DgRp_08]

回答ありがとうござきます。
質問にも記述しているコードで、
Application.ScreenUpdating=False
Application.Calculation = xlManual
は記載済みなのですが、これではないのでしょうか？？

[twyujiro15]

申し訳ありません。見落としていました。

Rows(i+1).Insert() を 2 回コールしているので、
これを 1 回にするだけでもかなり速くなるんじゃないでしょうか。
回答を修正しておきます。

[DgRp_08]

回答ありがとうございました！
２行ずつ挿入する方式に変更し、10秒ほどで完了するようになりました！
本当に助かりました！
また何か有りましたら是非、宜しくお願い致します！

Answer 4

画面の更新は切っておられますか？
相当な高速化が見込めるようです
このリンクの第１位に記載があります
行列の挿入について記載があります

Comments

[DgRp_08]

回答ありがとうござきます。
質問にも記述しているコードで、
Application.ScreenUpdating=False
Application.Calculation = xlManual
は記載済みなのですが、これではないのでしょうか？？

[kpiyohiko]

申し訳ないです。
１行目にありましたね。。。

オートシェイプの場所もランダムに配置されていますか？
場所が特定されているのであれば、オートシェイプを非表示にしてしまうという手があります。
http://www.geocities.co.jp/SiliconValley-PaloAlto/1200/html/v_30.htm

[DgRp_08]

ありがとうございます。
オートシェイプは、質問の画像の例でいうと、A列のデータに常に対応しているものとランダムなものがあります。ランダムといっても、A列のデータに関係するコメントの扱いなので、既存の位置とある程度れんどうさせなければなりません。
よって、非表示の手段を取ることかをできません。
ちなみに、データの数以上にオートシェイプは存在しているので、この辺の関係もあり大変苦戦しております。。。

[kpiyohiko]

列の挿入をループで実行するのではなく、どこに挿入するかあらかじめ調べて、一回ですべての場所に挿入する
くらいしかもう思いつかないですね。。。

[DgRp_08]

一括挿入も試そうとしたところ、指定数に上限があり、厳しいです。分けて挿入も考えましたが、挿入の度に行情報がずれていくので難しそうです。。