|
此れでどうかな?
Sub 年度経過削除()
Dim RR As Long, r1 As Range
Dim lngListEnd As Long
If MsgBox("年度変更によりデータを削除します。", _
vbOKCancel + vbExclamation, "年度更新") = vbCancel Then
Exit Sub
End If
With ActiveSheet
lngListEnd = .Cells(65536, "B").End(xlUp).Row
If lngListEnd < 4 Then
Exit Sub
End If
.Cells(4, "B").Resize(, 7).Value _
= .Cells(lngListEnd, "B").Resize(, 7).Value
' For RR = 4 To 20
For RR = 5 To lngListEnd
If .Cells(RR, 2).Value < .Cells(2, 9).Value Then '★?
On Error Resume Next
Set r1 = .Rows(RR).SpecialCells(xlCellTypeConstants)
If Not r1 Is Nothing Then
r1.ClearContents
End If
On Error GoTo 0
Set r1 = Nothing
End If
Next RR
End With
End Sub
|
|