0

这是另一个问题，我觉得有一个简单的答案，但我没有找到它。我正在遍历 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我得到错误。如果我单步执行代码，我可以看到它确实删除了第一行，但是在下一行出现错误。

我显然有多个“If Then”语句，但是如果满足第一个“If Then”条件并且该行被删除，它应该继续移动到下一个单元格。在我看来，它仍在尝试检查已删除的行。我绝对不是 Excel VBA 专家，但我认为应该在rCell.EntireRow.Delete告诉它移动到下一个单元格的部分之后添加一些内容。我尝试添加Next rCell，但错误出来了。 Exit For完全停止宏。

4

2 回答 2

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

Not sure if you wanted all to be EntireRow.Delete, but you can easily switch it back.

于 2012-12-11T00:54:25.567 回答
2

See below, I updated and changed some duplicate conditions. The best two ways are either add the data into a variant array, process and then delete or as brettdj mentions in the comment add a flag, filter and then mass delete. I prefer the below as it scales well and is good practise to know for other data manipulation. Not tested as no template to base it on. See below:

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
于 2012-12-11T10:33:51.390 回答