VBAエクセル、Now()より以前のデータ削除

質問

お世話になります。
range("B")列に日付がありその行にはRange(”C”）以下データがあります。
Range("B3")からRange("B30")までDELETEしたくない日付があり
Range("B31")からの日付はNow以前はDeleteしたいのですがどなたか構文を教えてください。
宜しくお願いします

回答No.1

kagakusuki · ベストアンサー

「TODAY()以前」や「Date以前」ではなく

>Now以前

と仰っておられるという事は、B列に入力されているデータとは「2016/01/22」などの様な「日付」データではなく、「2016/01/22 20:44:56」などの様な時刻も含んだ「日時」のデータであり、Now関数が返す値が例えば「2016/01/22 20:44:56」である場合には、「2016/01/22 20:44:55」や「2016/01/22 20:44:56」などの様な「2016/01/22 20:44:56」以前の日時が入力されている行は削除し、「2016/01/22 20:44:57」の様な「2016/01/22 20:44:56」以前の日時が入力されている行は残すという事で宜しいのでしょうか？
　それでしたら以下の様なVBAとなります。

Sub QNo9115488_VBAエクセルNowより以前のデータ削除()

Const DateColumn = "B" '日付が入力されている列
Const FirstRow = 31 '削除の対象となる可能性がある最初の行
Dim LastRow

With ActiveSheet
LastRow = .Range(DateColumn & Rows.Count).End(xlUp).row
If LastRow <= FirstRow Then
MsgBox "処理すべきデータがありません。" _
& vbCrLf & "マクロを終了します。" _
, vbExclamation, "データ無し"
Exit Sub
End If

With Application
.ScreenUpdating = False
.Calculation = xlManual
End With

.Range(DateColumn & FirstRow - 1 & ":" & DateColumn & LastRow) _
.AutoFilter Field:=1, Criteria1:="<=" & Now, _
Field:=1, Criteria2:="", Operator:=xlOr
.Range(DateColumn & FirstRow & ":" & DateColumn & LastRow) _
.SpecialCells(xlCellTypeVisible).EntireRow.Delete
.Cells.AutoFilter
End With

With Application
.CutCopyMode = False
.Calculation = xlAutomatic
.ScreenUpdating = True
End With

End Sub

お礼

そのものずばりで大満足です、これから組み込んでいきます有難うございました。