Удалить ошибку несоответствия строк

Question

Я пытаюсь удалить несколько строк в листе Excel на основе значения ячейки, которое является датой. Лист 1, D6 - дата.

Sub SAVE() 
'----- DELETE OLD ROWS ----- 
Dim r As Range 
Dim x As Integer 
Dim Monday As String 
Dim Tuesday As String 
Dim Wednesday As String 
Dim Thursday As String 
Dim Friday As String 
Dim Saturday As String 
Dim Sunday As String 
Monday = Sheet1.Range("D6").Value 
Tuesday = Sheet1.Range("D6").Value + 1 
Wednesday = Sheet1.Range("D6").Value + 2 
Thursday = Sheet1.Range("D6").Value + 3 
Friday = Sheet1.Range("D6").Value + 4 
Saturday = Sheet1.Range("D6").Value + 5 
Sunday = Sheet1.Range("D6").Value + 6 

For x = 5000 To 2 Step -1 '---> Change as needed 

    Set r = Range("A" & Format(x)) 
    If UCase(r.Value) = Monday Then 
    Rows(x).EntireRow.Delete 
    End If 

    Set r = Range("A" & Format(x)) 
    If UCase(r.Value) = Tuesday Then 
    Rows(x).EntireRow.Delete 
    End If 

    Set r = Range("A" & Format(x)) 
    If UCase(r.Value) = Wednesday Then 
    Rows(x).EntireRow.Delete 
    End If 

    Set r = Range("A" & Format(x)) 
    If UCase(r.Value) = Thursday Then 
    Rows(x).EntireRow.Delete 
    End If 

    Set r = Range("A" & Format(x)) 
    If UCase(r.Value) = Friday Then 
    Rows(x).EntireRow.Delete 
    End If 

    Set r = Range("A" & Format(x)) 
    If UCase(r.Value) = Saturday Then 
    Rows(x).EntireRow.Delete 
    End If 

    Set r = Range("A" & Format(x)) 
    If UCase(r.Value) = Sunday Then 
    Rows(x).EntireRow.Delete 
    End If 

Next 
End Sub 

Этот код работает иногда. Каждый раз я получаю ошибку времени выполнения «13» типа «Несоответствие». Когда я нажимаю debug, он выделяет If UCase(r.Value) = Monday Then.

Ошибка: r.Value = Error 2023, Monday = "7/4/2016"

Изображение листа он тянет из:

Любые идеи, что здесь происходит?

Answer 1

Я полагаю, что ниже код будет делать то, что вы собираетесь:

Sub SAVE() 
    ' Sheet1 is named "Control Panel", Sheet1 D6 has the pull date 
    ' Sheet5 is named "Database", has the stored dates to delete 
    '----- DELETE OLD ROWS ----- 
    Dim dtFrom As Date 
    Dim dtUpto As Date 
    Dim y As Long 
    Dim vCont As Variant 
    dtFrom = Sheets("Control Panel").Range("D6").Value 
    dtUpto = dtFrom + 6 
    With Sheets("Database") 
     For y = 5000 To 2 Step -1 
      vCont = .Cells(y, 1).Value 
      If Not IsError(vCont) Then 
       If vCont >= dtFrom And vCont <= dtUpto Then 
        .Rows(y).EntireRow.Delete 
       End If 
      End If 
     Next 
    End With 
End Sub 

Answer 2

резервную копию книги и попробовать этот рефакторинг (теперь модифицирована согласно предложению omegastripes'):

Sub SAVE() 
    '----- DELETE OLD ROWS ----- 
    Dim r As Range, x As Integer, y As Variant 

    y = Sheet1.Range("D6").Value + 3 

    For x = 5000 To 2 Step -1 
     Set r = Range("A" & x) 
     If DateDiff("d", y, r.Value) <= 3 Then Rows(x).EntireRow.Delete 
    Next x 
End Sub