VBAで削除を早くしたいのですが…

質問

Excel2007のVBAです。キー記録を眺めながら四苦八苦しております。
数千行あるデータで、A列が"d"以外の行を削除したいのですが
PCスペックが低いせいか、時間がかかってしまいます。
簡単に効率化することは可能でしょうか？
よろしくお願いします。
※1行目はタイトル列、全体行数は可変です。

Sub A05_A列がｄ以外は削除する()
Application.ScreenUpdating = False
Dim sh2 As Worksheet
Set sh2 = Worksheets("削list")
For i = Cells(Rows.Count, "C").End(xlUp).Row To 2 Step -1
If sh2.Cells(i, "A").Value <> "d" Then
Rows(i).Delete
End If
Next
Application.ScreenUpdating = True
End Sub

回答No.1

real beatin（@realbeatin） · ベストアンサー

こんにちは。

とりあえず、１万行のサンプルで試しながら書きました。
削除する行がテーブル下側に纏るように、
一旦ソートしておいてから一括削除します。
多分、この方法がXMLソースの書換え的に楽なんだと思います。

条件付きの他の方法として、
　●[列の非表示]や[グループ化]機能を使っていない場合で、
　　必ずしも削除する必要がないケースならば、
　　同じようにテーブル下側に纏めてから
　　range.ClearContents で消去した方が２割程速いです。

行数や列数等の条件によって、
削除する方法によっての遅速が変わってきますから、
数千件なら、この方法が速いかな？というお話です。
１万行５０列のサンプル中不要行４０％ランダムに配置
という条件で手許の環境では0.2秒弱でした。
何か不足あれば相談してください。

' ///

Sub Re8937081()
Dim rngA As Range
Dim rng As Range
Dim rngD As Range

　　With Application
　　　　.ScreenUpdating = False
　　　　.Calculation = xlCalculationManual
　　　　.EnableEvents = False
　　End With

　　With Sheets("削list")
　　　　If .FilterMode Then .ShowAllData

　　　　Set rngA = .Range("B2").CurrentRegion　'　テーブル全体をRange型で指定する

　　　　With rngA
　　　　　　.AutoFilter field:=1, Criteria1:="<>d"　'　A列が"d"以外の行を抽出
　　　　　　Set rng = .Range("A:A")
　　　　　　.Columns(1).Offset(1).ClearContents　'　A列が"d"以外のセルすべてをクリア（フラグ）
　　　　End With

　　　　.AutoFilterMode = False
　　End With

　　rngA.Sort Key1:=rng(1), Order1:=xlAscending, Header:=xlYes　'　A列が"d"のセルを上部に並べる

　　On Error Resume Next
　　Set rngD = rng.SpecialCells(xlCellTypeBlanks)　'　A列が"d"以外の行を選択
　　On Error GoTo 0

　　If Not rngD Is Nothing Then rngD.EntireRow.Delete　'　　'　A列が"d"以外の行を一括削除

　　With Application
　　　　.Calculation = xlCalculationAutomatic
　　　　.EnableEvents = True
　　　　.ScreenUpdating = True
　　End With
　　Set rng = Nothing:　　Set rngD = Nothing:　　Set rngA = Nothing
End Sub

' ///

お礼

realbeatin様とkagakusuki様のスクリプトは素晴らしく早くて、
思わず笑いが出てしまいました。

realbeatin様のスクリプトは一見長いですが、所々の注釈が
非常にありがたく、修正に対して柔軟性が高いと思い、自分に
とってはこちらが「より簡単」ではないかと感じましたので、
BAを差し上げたいと思います。

ありがとうございました。

回答No.5

kagakusuki

回答No.3,4です。

>realbeatin様の方は一見長いですが、所々の注釈が
非常にありがたく

との事でしたので、質問者様だけではなく、このサイト利用される他の方々にとっても、今後の参考になる様に、VBAの構文に注釈をつけたものを念の為に投稿致します。

Sub A05_A列がd以外は削除する◆注釈付()

'QNo.8937081 VBAで削除を早くしたいのですが…

Dim lr As Long 'データのある最終行の行数を示すための変数の定義

With Sheets("削list") '処理を行うシートを指定

lr = .Cells(Rows.Count, "C").End(xlUp).Row 'C列においてデータのある最終行の行数を取得

If lr < 2 Or Application.WorksheetFunction _
.CountIf(.Range("A2:A" & lr), "<>d") = 0 Then End
'↑もしデータのある最終行が2行目よりも上の行であるか、或いは
'A列において「2行目」～「『C列にデータのある最終行』と同じ行」の範囲内に、
'「値が『d』となっていないセル」(空欄のセルも含む)が存在しない場合には、マクロを終了

.Rows("1:" & lr).AutoFilter '1行目を項目名としたオートフィルターモードON

.Rows("1:" & lr).AutoFilter Field:=1, Criteria1:="<>d" 'A列の値が「dではない」行のみを選択して表示

.Rows("2:" & lr).Delete
'↑オートフィルターによって表示されている行の内、2行目～「C列にデータのある最終行」の範囲内にある行を削除

.Rows("1:" & lr).AutoFilter 'オートフィルターモードの解除

End With

End Sub

お礼

kagakusuki様
お返事遅れてすみません。
会社に行かないと環境が無かったもので…

わざわざ追加の投稿を頂きありがとうございます。
実は、BAを決めた後に「F8で追っかければいいやん」
と当たり前のことを再発見し、自分で細々とコメントを
付けていました。今回の回答は、答え合わせにもなり
安心できました。
ありがとうございました。

回答No.4

kagakusuki

回答No.3です。
　申し訳御座いません。回答No.3のVBAには、A列が"d"となっている行"のみ"である場合において、2行目以下の全ての行が削除されてしまうという欠陥が御座いました。
　以下のVBAは、その欠陥を無くしたものです。

Sub A05_A列がd以外は削除する()

'QNo.8937081 VBAで削除を早くしたいのですが…

Dim lr As Long 'データのある最終行
With Sheets("削list")
lr = .Cells(Rows.Count, "C").End(xlUp).Row
If lr < 2 Or Application.WorksheetFunction _
.CountIf(.Range("A2:A" & lr), "<>d") = 0 Then End
.Rows("1:1").AutoFilter
.Rows("1:" & lr).AutoFilter Field:=1, Criteria1:="<>d"
.Rows("2:" & lr).Delete
.Rows("1:1").AutoFilter
End With

End Sub

お礼

realbeatin様とkagakusuki様のスクリプトは素晴らしく早くて、
思わず笑いが出てしまいました。

kagakusuki様のスクリプトは「簡単に効率化」という点では
短くてよいと思います。

しかしながら、realbeatin様の方は一見長いですが、所々の注釈が
非常にありがたく、本質的にはこちらが「より簡単」ではないかと
感じてしまったので、申し訳ないですが今回はrealbeatin様の方に
BAを差し上げたいと思います。

訂正版まで上げていただいたのにこのような連絡となり誠に申し訳
ございません。これに懲りずに、また困ったことがありましたら
お助けいただけると幸いです。

ありがとうございました。

回答No.3

kagakusuki

何もFor～Nextを使って1行ずつ処理せずとも、オートフィルターを使ってA列が"d"以外の行を一気に削除してしまう様にすれば良いのではないでしょうか。
　因みに、バージョンがExcel2003以前のExcelの場合は、オートフィルターで仕分けられる限度が1000行までしかありませんでしたが、Excel2007からはその様な限界が無くなったそうです。

Sub A05_A列がd以外は削除する()

'QNo.8937081 VBAで削除を早くしたいのですが…

Dim lr As Long 'データのある最終行の行番号
With Sheets("削list")
lr = .Cells(Rows.Count, "C").End(xlUp).Row
.Rows("1:1").AutoFilter
.Rows("1:" & lr).AutoFilter Field:=1, Criteria1:="<>d"
.Rows("2:" & lr).Delete
.Rows("1:1").AutoFilter
End With

End Sub

回答No.2

t-aka

ソースコードそのものは特に問題ないような印象です。

もしもワークブックに数式が含まれている場合は
再計算を一時的に手動に設定すると処理の高速化が図れます。
Application.Calculation = xlCalculationManual
と宣言してください。

処理が終了する時は
Application.Calculation = xlCalculationAutomatic
として、再計算を自動化しましょう。

あるいは、元データがCSVなどのテキストファイルの場合は
Excel上で展開せずに処理すると動作は軽くなります。

お礼

xlCalculationManualは、たまにテンプレ的に見かけたのですが
意味が分からずとりあえずは放置…としておりました。
今回の自分の表では計算式はその都度実数化してるのですが、
(次に投げられる予定の)上司の作った表は計算式が多用されておりますので、
きっと未来で感謝させていただくと思います。
お返事ありがとうございました。