删除行不匹配错误

我试图根据date的单元格值删除Excel工作表中的一些行。 工作表1，D6是一个date。

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”types不匹配。 当我点击debugging，它突出显示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的build议修改）：

 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