特定の条件を満たす行を高速削除する

特定の条件を満たす行を削除する方法としては、

• For文+Step-1で逆順にループして条件を満たす行を1行ずつ消していく
• 条件を満たす行をUnionで一つのRangeに貯めて最後に一括削除する

この二つの方法があります。

1つ目の方がコーディングは簡単で、2つ目はちょっと面倒な分早いです。

しかし、中にはデータが膨大だったり、大量の数式があったりで、
2つ目の方法ですら遅い場合が起こりえます。

そのとき、より高速な方法としては、

1. 削除対象か判定する列を作る
2. その列をキーにデータをソートする
3. 削除対象のデータが1ヶ所にまとまるのでこれを削除する

という方法をとることができます。

Unionによる削除は「エリアの数」に応じて遅くなるのですが、
この方法なら1エリアだけを削除するため一瞬で削除が終わります。
※ その分ソートに時間がかかりますが、大抵は大量エリアの削除の方が遅いです。

削除対象列を「True/False」だけにしておけば元の順は維持できますしね。

本記事ではこの高速削除のソースコードを解説します。

Callして使える関数になっておりますので、
加工して使うなり、中身を見ずに使うなり、好きなようにお使いください。

ソースコード

' 不要行の削除
Sub 指令列がTRUEの行を高速削除する(データエリア全体 As Range, 判定列 As Long)

    Dim ws対象シート As Worksheet: Set ws対象シート = データエリア全体.Worksheet

    Dim column判定列 As Range
    Set column判定列 = Intersect(データエリア全体, ws対象シート.Columns(判定列))
    If column判定列 Is Nothing Then Exit Sub

    Dim RCount削除行数 As Long
    RCount削除行数 = WorksheetFunction.CountIf(column判定列, True)
    If RCount削除行数 = 0 Then Exit Sub

    ' ソートしてTRUEを1エリアにまとめる
    データエリア全体.Sort ws対象シート.Cells(1, 判定列)

    ' 第1TRUE行から削除行数分を削除
    Dim R1st削除開始行 As Long
    R1st削除開始行 = WorksheetFunction.Match(True, column判定列, 0) + column判定列.Row - 1
    ws対象シート.Rows(R1st削除開始行).Resize(RCount削除行数).Delete

End Sub

使用例

以下のデータから「売上が1000未満のデータを削除する」場合は、
以下のようなソースコードで実行できます。

Sub 売上が1000以下の行を削除する()
    
    Dim ws売上データ As Worksheet
    Set ws売上データ = ThisWorkbook.Worksheets("○○")
    
    Dim 最終行 As Long
    最終行 = ws売上データ.Cells(ws売上データ.Rows.Count, 5).End(xlUp)
    
    ws売上データ.Range("F4:F" & 最終行).Formula = "=E4<1000"
    
    Call 指令列がTRUEの行を高速削除する(ws売上データ.Range("B4:F" & 最終行), 6)
    
End Sub

肝心の削除は当然ですが1行なのでいいですね。

削除したいデータエリアを取得し、それをCallする関数に渡すだけです。

削除対象に「TRUE」を立てるのはF列を作業列として使用しました。

これをFor文で判定すると遅くなるため、
サンプルのようにFormulaで数式計算するのがおすすめです。

Formulaに関する詳細はこちらの記事をどうそ。

コードの解説

1. 削除対象か判定する列を作る
2. その列をキーにデータをソートする
3. 削除対象のデータが1ヶ所にまとまるのでこれを削除する

この手順の2と3を愚直に実行しているコードです。

削除行数をCountIf関数で取得しておくことで、

• 削除行を「削除第1行.Resize(削除行数)」で取得できる
• 削除第1行検索のMatch関数がエラーにならないことをチェックできる

と一石二鳥なので参考にしてみてください。