基準日以前のデータを範囲を指定して削除するVBA

図のような表（B列からK列は非表示にしてあります）
L列の日付はおおむね上から順にあとの日付になっています。
O2の日付を基準にそれ以前のデータを削除するため下記のVBAで削除していますが、行数が多いと時間がかかるため、L列の基準日のセル番地を求め、その行のMからA2を範囲を選択してし、削除するVBAを教えてください。
（現在使用のもの）
Dim i As Long
For i = Cells(Rows.Count, "L").End(xlUp).Row To 2 Step -1
If Range("L" & i).Value <= Range("O1") Then
Range("A" & i, "M" & i).Delete
End If
Next i

No.1 ベストアンサー 回答者： tom04 回答日時： 2018/02/23 18:00

こんにちは！

行全体ではなく、A～M列だけの削除（上詰め）がご希望なのですね。
一例です。

Sub Sample1()
Dim i As Long, myRng As Range
For i = 2 To Cells(Rows.Count, "L").End(xlUp).Row
If Cells(i, "L") <= Range("O1") Then
If myRng Is Nothing Then
Set myRng = Range(Cells(i, "A"), Cells(i, "M"))
Else
Set myRng = Union(myRng, Range(Cells(i, "A"), Cells(i, "M")))
End If
End If
Next i
If Not myRng Is Nothing Then '//←念のため//
myRng.Delete shift:=xlUp
End If
End Sub

こんな感じではどうでしょうか？m(_ _)m

この回答へのお礼

お二人から回答頂きましたが、どちらの回答を試してもこれまでのものとは段違いの速さで処理されました。
私はベストアンサーを選びきれませんが、最初に回答いただいた方をベストアンサーとさせていただきました

お礼日時：2018/02/24 13:00

No.2 回答者： WindFaller 回答日時： 2018/02/23 23:18

他の環境でうまくいくかどうかは、まったく保証できませんが、コードをみて、オートフィルタを使っていますから、だいたいの所は見当が付くと思います。

'//標準モジュール
''Option Explicit
Sub FilterDel()
　　　　Dim LastRow As Long
　　　　Dim Rng As Range
　　　　Dim vRng As Range
　　　　If ActiveSheet.AutoFilterMode Then
　　　　　　　　ActiveSheet.AutoFilterMode = False
　　　　End If
　　　　Set Rng = Range("A1", Cells(Rows.Count, "L").End(xlUp)).Resize(, 13)

　　　　If Rng.Rows.Count < 3 Then Exit Sub
　　　　If VarType(Range("O1").Value) <> vbDate Then Exit Sub
　　　　With Rng '12=L列, Criteria1 は、検索式
　　　　　　　　.AutoFilter _
　　　　　　　　　　Field:=12, _
　　　　　　　　　　Criteria1:="<=" & Range("O1").Value
　　　　End With
　　　　On Error Resume Next
　　　　With Rng.EntireRow　　'行全体に範囲を広げている、先に、タイトル行を外さないと選択できません
　　　　　　　　Set Rng = .Offset(1).Resize(.Rows.Count - 1)
　　　　End With
　　　　Set vRng = Rng.SpecialCells(xlCellTypeVisible)
　　　　On Error GoTo 0
　　　　If vRng.Rows.Count > 1 Then
　　　　　　　　vRng.Delete
　　　　Else
　　　　　　　　MsgBox "対象の行が見当たりません", vbQuestion
　　　　End If
　　　　Beep
　　　　ActiveSheet.AutoFilterMode = False
End Sub

この回答へのお礼

毎回、適切な回答ありがとうございます。お二人から回答頂きましたが、どちらの回答を試してもこれまでのものとは段違いの速さで処理されました。
私はベストアンサーを選びきれませんが、最初に回答いただいた方をベストアンサーとさせていただきました。

お礼日時：2018/02/24 12:58