如何遍歷特定列中的單元格並根據其內容刪除整行？

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.Interior.Color = RGB(255, 102, 0) rCell.EntireRow.Delete rCell.EntireRow.Interior.Color = RGB(255, 102, 0)替換為rCell.EntireRow.Delete出現錯誤。 如果我單步執行代碼，可以看到它確實刪除了第一行，但是在下一行出錯了。

我顯然有多個“ If Then”語句，但是如果滿足第一個“ If Then”條件並刪除了該行，則應繼續到下一個單元格。 在我看來，它仍在嘗試檢查已刪除的行。 我絕對不是Excel VBA專家，但我認為rCell.EntireRow.Delete部分之后應添加一些內容，以rCell.EntireRow.Delete其移至下一個單元格。 我嘗試添加Next rCell ，但是出錯了。 Exit For完全停止宏。

Answer 1

邁克，當您遍歷范圍集並刪除行時，您需要從最后一行開始向后遍歷，因為當您刪除某行時，該行不再存在，並且它通過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 ，但是可以輕松地將其切換回去。

Answer 2

參見下文，我更新並更改了一些重復的條件。 最好的兩種方法是將數據添加到變量數組中，進行處理，然后刪除，或者如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