EXCEL VBA – 行削除をまとめて短時間で行う方法

私は、EXCELでは、ワークシートのデータを別シートにデータベースとして保存していくマクロをよく使います。
その時、ある項目（例えば日付）について重複するデータがあればメッセージボックスで上書き可否を問いかけ、可なら上書きするのですが、その場合、まず、重複する行を削除する必要があります。
行数が多い場合、1行ずつ判定して行削除（EntireRow.Delete）していくのは時間がかかりますので、まずは削除対象をすべてRangeオブジェクトに格納して、EntireRow.Deleteを一度で済ませると格段に早くなります。

以下は、A列に日付が入っているワークシート（Sheet1）の2行目から最終行までをループし、A列セルが開始日（2017/3/16）から終了日（2018/3/15）の期間内の日付である行を削除するコードです。

Option Explicit

'###### 期間内行削除 ######
Sub delete_Row()
 Dim lRow As Long '最終行を見つけるための変数
 Dim delArea As Range '削除対象のRangeオブジェクトを格納する変数
 Set delArea = Nothing 'オブジェクトへの参照を解除
    
 Dim ws As Worksheet
 Set ws = Worksheets("Sheet1") '対象ワークシート
    
 Dim startDate As Date '期間開始日
 startDate = DateSerial(2017, 3, 16)
 Dim endDate As Date '期間終了日
 endDate = DateSerial(2018, 3, 15)
    
 lRow = ws.Cells(Rows.Count, 1).End(xlUp).row 'A列最終行
    
 Dim Rng As Range '削除対象を見つけるための変数
 For Each Rng In Range(Cells(2, 1), Cells(lRow, 1)) '削除対象検索の範囲（A列日付）
  '期間開始日とセル値の差が0日以上（セル値が期間開始日以上）かつ、
  '期間終了日とセル値の差が0日以下（セル値が期間終了日以下）の場合
  If DateDiff("d", startDate, Rng.Value) >= 0 And DateDiff("d", endDate, Rng.Value) <= 0 Then
   If delArea Is Nothing Then
    Set delArea = Rng '削除対象セルを格納
   Else
    Set delArea = Union(delArea, Rng) '次の削除対象セルを併せて格納を繰り返す
   End If
  End If
 Next

 If Not delArea Is Nothing Then
  Application.ScreenUpdating = False '画面更新を停止
  Application.EnableEvents = False 'イベント発生を停止
                
  delArea.EntireRow.Delete '行削除
                
  Application.EnableEvents = True 'イベント発生再開
  Application.ScreenUpdating = True '画面更新再開
 End If
End Sub

上記はFor Each文を使っていますが、For Next文だと下記のようになります。

Option Explicit

'###### 期間内行削除その2 ######
Sub delete_Row2()
 Dim lRow As Long '最終行を見つけるための変数
 Dim delArea As Range '削除対象のRangeオブジェクトを格納する変数
 Set delArea = Nothing 'オブジェクトへの参照を解除

 Dim ws As Worksheet
 Set ws = Worksheets("Sheet1")'対象ワークシート

 Dim startDate As Date '期間開始日
 startDate = DateSerial(2017, 3, 16)
 Dim endDate As Date '期間終了日
 endDate = DateSerial(2018, 3, 15)

 Dim r As Long '削除対象行を見つけるための変数
 lRow = ws.Cells(Rows.Count, 1).End(xlUp).row 'A列最終行
 For r = lRow To 2 Step -1 '最終行から2行目までループ
  'セル値が期間開始日以上、かつ、期間終了日以下の場合
  If ws.Cells(r, 1).Value >= startDate And ws.Cells(r, 1).Value <= endDate Then
   If delArea Is Nothing Then
    Set delArea = ws.Cells(r, 1) '削除対象セルを格納
   Else
    Set delArea = Union(delArea, ws.Cells(r, 1)) '次の削除対象セルを併せて格納を繰り返す
   End If
  End If
 Next r

 If Not delArea Is Nothing Then
  Application.ScreenUpdating = False '画面更新を停止
  Application.EnableEvents = False 'イベント発生を停止
                
  delArea.EntireRow.Delete
                
  Application.EnableEvents = True 'イベント発生再開
  Application.ScreenUpdating = True '画面更新再開
 End If
End Sub

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