如何循環訪問特定列中的單元格並根據其內容刪除整行？

Question

這是另一個問題，我覺得有一個簡單的答案，但我沒有找到它。我遍歷D列中的每個單元格並尋找特定日期（來自用戶輸入），並基於該單元格的日期和某些相應單元格中的日期，我正在更改該行的顏色。

相反着色排的，我希望能夠將其刪除。

這裏是我的代碼，目前顏色的那些行：

Range(Cells(2, 4), Cells(Rows.Count, 4).End(xlUp)).Select 

Dim rCell, otherCell As Range 
Dim TheAnswer$ 
Dim ConvertedDate# 

TheAnswer = InputBox("In M/D/YY format, enter the first day of the month for which this report is being run." & _ 
        vbCr & vbCr & "For example, you would enter ""12/1/2012"" for the December 2012 report.", "Enter Date M/D/YY") 
ConvertedDate = CDate(TheAnswer) 

For Each rCell In Selection 
    If rCell.Value <> "" Then 
     If rCell.Value And rCell.Offset(, 5) < ConvertedDate And rCell.Offset(, 5) <> "" Then rCell.EntireRow.Interior.Color = RGB(255, 102, 0) 

     If rCell.Value < ConvertedDate And rCell.Offset(, 5) = "" Then 

      If rCell.Offset(, 6) < ConvertedDate And rCell.Offset(, 6) <> "" Then rCell.EntireRow.Interior.Color = RGB(255, 102, 0) 

      If rCell.Offset(, 7) < ConvertedDate And rCell.Offset(, 7) <> "" Then rCell.EntireRow.Interior.Color = RGB(255, 102, 0) 

     End If 

    End If 
Next rCell 

當我與rCell.EntireRow.Delete替代rCell.EntireRow.Interior.Color = RGB(255, 102, 0)我得到的錯誤。如果我單步執行代碼，我可以看到它實際上刪除了第一行，但是在下一行發現了錯誤。

我明明有多個「如果那麼」語句，但是如果第一個「如果那麼」條件被滿足，並且行被刪除，就應該移動到下一個單元格。在我看來，它仍然試圖檢查那個被刪除的行。我絕對不是Excel VBA專家，但我認爲應該在rCell.EntireRow.Delete之後添加一些內容，以告訴它移動到下一個單元格。我試過在Next rCell中加入，但是出錯了。 Exit For只是完全停止宏。

Answer 1

看下面，我更新了一些重複的條件。最好的兩種方法是將數據添加到變體數組中，然後刪除或作爲brettdj提及的註釋添加標記，過濾然後批量刪除。我更喜歡下面的內容，因爲它可以很好地擴展並且是知道其他數據操作的良好實踐。不作爲沒有模板的基礎上進行測試。見下：

Dim data() As Variant 
Dim i As Double 
Dim deleteRows As Range 
Dim sht As Worksheet 

Dim theAnswer As String 
Dim ConvertedDate As Date 

Set sht = Sheet1 

theAnswer = InputBox("In M/D/YY format, enter the first day of the month for which this report is being run." & _ 
       vbCr & vbCr & "For example, you would enter ""12/1/2012"" for the December 2012 report.", "Enter Date M/D/YY") 
ConvertedDate = CDate(theAnswer) 

data = sht.Range(Cells(2, 4), Cells(Rows.Count, 4).End(xlUp)).Resize(, 8) 

    For i = 1 To UBound(data, 1) 

     If (data(i, 1) <> vbNullString) Then 

      If data(i, 1) <> vbNullString And data(i, 6) < ConvertedDate And data(i, 6) <> vbNullString Then 

       If (deleteRows Is Nothing) Then 
        Set deleteRows = sht.Rows(i + 1) 
       Else 
        Set deleteRows = Union(deleteRows, sht.Rows(i + 1)) 
       End If 

      ElseIf data(i, 1) < ConvertedDate And data(i, 7) <> vbNullString And data(i, 8) <> vbNullString Then 

       If data(i, 7) < ConvertedDate Or data(i, 8) < ConvertedDate Then 

        If (deleteRows Is Nothing) Then 
         Set deleteRows = sht.Rows(i + 1) 
        Else 
         Set deleteRows = Union(deleteRows, sht.Rows(i + 1)) 
        End If 

       End If 

      End If 

     End If 

    Next i 

deleteRows.Delete Shift:=xlUp 

Answer 2

邁克，當你遍歷範圍設置和刪除行，你需要從最後一排環落後，因爲當你刪除一行，不存在了，它得來的Excel，因爲該行已不再在循環範圍。

試試這個：

Range(Cells(2, 4), Cells(Rows.Count, 4).End(xlUp)).Select 

Dim rCell as Range, otherCell As Range 
Dim TheAnswer$ 
Dim ConvertedDate# 

TheAnswer = InputBox("In M/D/YY format, enter the first day of the month for which this report is being run." & _ 
        vbCr & vbCr & "For example, you would enter ""12/1/2012"" for the December 2012 report.", "Enter Date M/D/YY") 
ConvertedDate = CDate(TheAnswer) 

Dim xrows as Long, i as Long 
xrows = Selection.Rows.Count 

For i = xrows to 1 Step -1 

    Set rCell = Selection.Cells(i,1) 

    If rCell.Value <> "" Then 
     If rCell.Value And rCell.Offset(, 5) < ConvertedDate And rCell.Offset(, 5) <> "" Then rCell.EntireRow.Delete 

     If rCell.Value < ConvertedDate And rCell.Offset(, 5) = "" Then 

      If rCell.Offset(, 6) < ConvertedDate And rCell.Offset(, 6) <> "" Then rCell.EntireRow.Delete 

      If rCell.Offset(, 7) < ConvertedDate And rCell.Offset(, 7) <> "" Then rCell.EntireRow.Delete 

     End If 

    End If 

Next i 

不知道，如果你想都成爲EntireRow.Delete，但你可以很容易地切換回來。