Excel VBA データ削除の高速化

質問

今晩は，質問させていただきます．どうぞよろしくお願いいたします．
　Win7 + Excel2007でございます。

　B～D列の、1～300,000行程にデータが入っており、グラフ化する際に重いです。
そこでこれを周期的に間引く為に
（例えば、10行消して1行残す→また10行消して・・・の繰り返し）、

.Range(.Cells(行1, 2), .Cells(行2, 4)).Delete Shift:=xlUp

を繰り返すコードを作成いたしました。
が、非常に動作が遅く、数千行実行するのにも暫く時間がかかるほどでございます。。。

　原因を解明すべく検索いたしておりますと、VBAの中でもデータ削除が原因で
マクロ動作が遅くなるケースは珍しく無いようでございます。
他のコーディング方法で何か、上記より早い方法というのは
あるのでございますでしょうか？
　もしお詳しい方がいらっしゃいましたら，是非アドバイスいただけないでしょうか。
どうぞよろしくお願いいたします。

回答No.4

Randomize · ベストアンサー

押してダメなら引いてみるという考えで少し変わった解法を紹介します。
　行を削除する時にExcel内では削除により範囲の結果が変化する影響の評価などを内部で行なっているため、回数が重なるほどどんどん重たくなってしまいます。
　そこで逆転の発想、「消したらダメなら抜き取ったデータをどこかに表示すればいいじゃない」というのがこの解法の基本目的です。まずはソースから。特殊なことはしていないのでExcel2007でも問題なく動作するとは思いますが、当方の環境がExcel2003までですので、動かなかった場合はすみません。

'=====プログラムここから=====
Private Sub ThinOutData()
Dim varRangeReadData() As Variant, varRangeWriteData() As Variant
Dim NowReadRow As Long, MaxReadRow As Long, NowWriteRow As Long
Dim NowReadColumn As Long

Const MaxReadColumn As Long = 4 '表の列数を指定
Const SkipRowNum As Long = 10 '何行に1個のデータを抽出するかを指定

With ThisWorkbook.Worksheets("Sheet1") '処理対象のシートを記入してください
MaxReadRow = .Cells(.Rows.Count, 1).End(xlUp).Row '最終行を取得
'元データを変数へコピー(タイトル行は除くので2行目から格納)
varRangeReadData = .Range(.Cells(2, 1), .Cells(MaxReadRow, MaxReadColumn)).Value
'最終行の数より、抽出するデータ範囲を準備する
ReDim varRangeWriteData(1 To Int(MaxReadRow / SkipRowNum) + 1, 1 To MaxReadColumn)
MaxReadRow = UBound(varRangeReadData, 1) '最終行を数字を変数の行数に変更しておく
'抽出開始
NowWriteRow = 1
For NowReadRow = 1 To MaxReadRow Step SkipRowNum
'列内容を複写
For NowReadColumn = 1 To MaxReadColumn
varRangeWriteData(NowWriteRow, NowReadColumn) = varRangeReadData(NowReadRow, NowReadColumn)
Next
NowWriteRow = NowWriteRow + 1
Next
'結果をExcelへ書き出す
'結果を書き出したい場所の左上を指定してください
With .Range("H1")
'まずはタイトル行をコピーしてくる
.Parent.Range(.Offset(0, 0), .Offset(0, MaxReadColumn - 1)).Value = .Parent.Range(.Parent.Cells(1, 1), .Parent.Cells(1, MaxReadColumn)).Value
.Parent.Range(.Offset(1, 0), .Offset(UBound(varRangeWriteData, 1) - 1, MaxReadColumn - 1)).Value = varRangeWriteData
End With
End With
End Sub
'=====プログラムここまで=====

　元のデータはA1に左上詰めで記入されているもの仮定しています。
　Excelのデータ処理は、読み込みは早いが書き込みと消去は遅いです。よって、いかにこれらの作業を1回にまとめるかが高速化の鍵になります。

　このプログラムには1個の知恵と1個のテクニックが用いられています。
　知恵の方は、以下に消去の回数を減らすかということの裏返しですね。消すのではなく、新たにどこかに記入することでちまちまとした削除する作業を0回にしてしまおうというものです。
　テクニックの方は、毎回毎回Excelのセルに書き込むとそのたびにExcelが内容が正しいか、内容がどの種類であるかを確認する作業が入るためどうしても処理が遅くなってしまいます。そのため、一旦2次元配列変数の中にデータを格納してしまい、それを一気にExcelへ転送して書きこむことをします。それによって、Excelが内容を確認するのは1回のみになるので、これだけでも処理速度は10～30倍近く早くなります。これを解説しているサイトを1個紹介します。
http://officetanaka.net/excel/vba/speed/s11.htm

　ちなみに、このプログラムで処理した場合と元々のDeleteで処理した場合の速度ですが、65500行を処理するのにDeleteでは138秒かかるのに対し、回答のプログラムの方は0.09秒で処理を完了できました。

　このプログラムは、With .Range("H1")の部分を変更することで出力先を変更することができますが、このプログラムのままではほかシートへ出力することはできません。もし、他のシートへ出力したい場合は、With .Range("H1")以下のプログラムを少しいじってあげてください。(タイトル行のコピーの部分をなくせば「.Range("H1")」の部分を変更するだけで対応は出来ます。)

　あと補足ですが、この回答のプログラムでは、書き込み回数が1回のためScreenUpdatingプロパティーをいじっていません。(1回だけですので再描画制御をしなくても十分高速なため)　もし、何度も書き込みやセルの書式を変更や削除をするなどを行う場合はScreenUpdatingを処理中はFalseに設定する事を勧めます。

　そして前の回答にあるのですが、DoEventsは処理中に他のイベントがあったかを確認するためのもので、中止処理を実装する時等以外は単に処理時間を長くしてしまうだけです。進捗状況を確認させたい場合はApplication.Statusbarを用いてExcelのステータスバーに進捗の文字列を表示する方が好ましいです。ただし、こちらも更新頻度を密にしすぎると無駄に処理時間を伸ばすだけですので、0.1秒に1回表示位の頻度に抑えておくのがよろしいでしょう。
timeGetTime APIを用いているのですが、このような実装です。timeGetTime APIの使い方は他サイトを参考にしてください

'宣言部
Private Declare Function timeGetTime Lib "winmm.dll" () As Long

'実際に使用している部分　これをループ処理の中に記述すると進捗状況の概要がステータスバーに表示されます
If LastTime + 100 <= timeGetTime Then '前回表示から100ミリ秒以上経過している場合
　　Application.StatusBar = "現在、" & NowRowCount & "行目を処理中です..."
　　LastTime = timeGetTime
End If

'終わったら
Application.StatusBar = False 'Falseを代入するとステータスバーの内容がクリアされます

今後のステップアップの糧になれば幸いです。

お礼

どうもありがとうございます！！m(_ _)m
＞当方の環境がExcel2003までですので、動かなかった場合はすみません
動きました＾＾ｂ　結果からお話いたしますと、「超超超早い」です(・＿・)！
２５万行の処理が０．５秒でございました。。。

＞削除により範囲の結果が変化する影響の評価などを内部で行なっているため、回数が重なるほどどんどん重たくなってしまいます。
なるほどそういう理屈でございましたか。（-ω'-）

＞読み込みは早いが書き込みと消去は遅いです。よって、いかにこれらの作業を1回にまとめるかが高速化の鍵になります。
はい、どうもありがとうございます。勉強になりますm(_ _)m

＞Application.Statusbar
あ、存じませんでした、これ＾＾；
timeGetTime についても一緒に検索してまいります。

＞一旦2次元配列変数の中にデータを格納してしまい、それを一気にExcelへ転送して書きこむことをします。
↑今回はここが一番、知らなかった事で面白かったです。配列はそれを作る事自体が楽しいので
たまに利用するのでございますが、データの呼び出しとソート時に便利な程度に考えておりました。。。

＞今後のステップアップの糧になれば幸いです。
滅茶苦茶なりました！！m(_ _)m
面白かったでございます。この度はご親切にご閲覧・アドバイスいただきまして
誠にありがとうございました！！

補足

（お礼後の補足になります）

今回皆様からお教えいただけたアイディア＆技術は非常に面白い物ばかりでございました。
閲覧して下さる方々は是非、ベストアンサー以外のご回答にも目を通してみてください。非常に早いコードがあります。
　ベストアンサーには迷いましたが、一番知恵の数が多く皆様の知識向上に役立ちそうなRandomize様の物にさせていただきました。
　皆様からいただけたお知恵に重ねて感謝の意を表します。
どうもありがとうございました！！(｀´)ゞ

回答No.5

hallo-2007

>グラフ化する際に重いです。
パソコンの仕様が限界？
>数千行実行するのにも暫く時間がかかるほどでございます
データを利用した関数が設定されている？
VBAを実行＝＞削除されると関数が実行の繰り返しになっているのでは？

ここは、方向性を変えて
新しいブックを作って、１０行おきにデータをコピーしてみる方法は如何でしょうか。
こんな感じでは如何でしょうか。

Sub ボタン1_Click()
Workbooks.Add
J = 1
For i = 1 To 300000 Step 10
Range("B" & J & ":D" & J).Value = ThisWorkbook.Sheets(1).Range("B" & i & ":D" & i).Value
J = J + 1
Next
End Sub
元データも残りますし便利かと思いますが。

お礼

どうもありがとうございます！！m(_ _)m

なるほどこの方法も早いですね、２５万行が３秒ちょっとで片付きました＾＾
自分のコードは３０分（１８００秒）かかりましたが。。
（しかもコードがこの５倍くらいでございますorz）

VBAは可能性が広く面白いですねー。
この度はご親切に誠にありがとうございました！！＾＾

回答No.3

keithin

A1:D300000に生数字のデータが入っている条件で実測してみると3.6秒でした。

Sub macro4()
　Range("F1") = Timer
　Range("E1") = 1
　Range("E1:E11").AutoFill Destination:=Range("E1:E300000")
　Cells.Sort key1:=Range("E1"), order1:=xlAscending, Header:=xlNo
　Range(Cells(Cells.Rows.Count, "E").End(xlUp).Offset(1), Cells(Cells.Rows.Count, "A").End(xlUp)).EntireRow.Delete
　Range("G1") = Timer
End Sub

お礼

どうもありがとうございます！！m(_ _)m
滅茶苦茶早いです＾＾ｂ

Sortの為のナンバリングはFor～NextかもしくはLoopでやるものとばかり
思っておりましたが、ナルホドAutoFillすればいいんでございますすねー(・o・)
　あと私のコードの一部とCells.Sortがうまく動いてくれませんでしたので、
自動記録して
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("AA1:AA" & 終了行), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SetRange Range("A1:AA" & 終了行)
.Sort.Header = xlGuess
.Sort.MatchCase = False
.Sort.Orientation = xlTopToBottom
.Sort.SortMethod = xlPinYin
.Sort.Apply
に変更いたしまして成功いたしました。

　作業データの横に崩したくないフォーマットがございましたので
出来ればDeleteする列を限定したかったのでございますが、
今回のやり方を適用するため一旦、他のシートにデータを丸ごと移して
Row.Deleteしてから元のシートにデータを戻すようにいたしました。

　ちなみに本質問をさせていただいた時のスピードと比較いたしますと、
５００倍の超高速化でございます＾＾　コードも半分くらいの
短さになりましたし＾＾ｂ。。。。。。orz

　こういう「ナルホド」があるのでVBA（特にExcel）は面白いですね。
この度はご閲覧いただけたお陰で助かりました！ご親切に誠にありがとうございました！m(_ _)m

回答No.2

f272

データのある列の横の列に
残したいところは0
消したいところは1
のようにデータを作って，それをキーにして並べ替えを行い，最後に一気に削除する。

お礼

どうもありがとうございます！m(_ _)m
なるほどSortしてしまえば、Deleteが一回で済みますね＾＾
Sortは細かい挙動に対する知識がございませんでした故
（もし同じ物があった場合にどちらが優先になる、とか）、
たまに予期せぬ挙動をされるのが怖くVBAではいつも
あまり触らぬようにしておりました。。。

頑張って参ります！！！この度はご親切にどうもありがとうございました！！

回答No.1

tohru999

どの程度軽減できるかわかりませんが．．．
試しに、
Deleteの前に
Application.ScreenUpdating = False

繰り返し処理終了後に
Application.ScreenUpdating = True

を入れてみてはどうでしょうか？

後、余計なお世話かもしれませんが、
削除処理が大量にあり時間がかかる場合は、フリーズしている？と思われてしまうので
繰り返し処理中に
DoEvents()
を入れてみるのも良いかも

お礼

どうもありがとうございます！
ScreenUpdatingはいつもFalseにしております。
＞DoEvents（）
確かに試しておりませんでした＾＾
今後試すようにいたします。

この度はご親切にどうもありがとうございました！！m(_ _)m