删除行不匹配错误

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

此代码有时有效。我经常遇到运行时错误＆＃39; 13＆＃39;类型不匹配。当我点击调试时，会突出显示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