如何遍历特定列中的单元格并根据其内容删除整行？答案

【问题标题】：How do I loop through cells in a specific column and delete the entire row based on its contents?如何遍历特定列中的单元格并根据其内容删除整行？
【发布时间】：2012-12-14 03:33:50
【问题描述】：

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

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

【问题讨论】：

更详细地查看您的数据会很有用。删除行（手动或使用 VBA）的一种有效方法是在返回 TRUE 或 FALSE 的每一行上设置布尔 IF 测试，如果满足要删除的条件，则使用 Autofilter 删除满足的条件。范围循环可能非常慢
我的电子表格没有什么特别之处。它基本上只是 D-K 列中的日期列表。我不熟悉Autofilter，所以我想我必须调查一下。从我上面的代码中可以看出，我最初的方法是更改行颜色。我还想我也可以（或替代地）向其中一个单元格添加一些内容，然后删除单元格中包含该添加内容的所有行。

标签： excel vba

【解决方案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

【讨论】：

感谢您的帮助，Philip，但我也无法让您的代码正常工作。我注意到的第一件事是缺少End If，但即使我添加了一个，我也会在deleteRows = Sheet1.rows(i + 1) 的行上收到运行时错误（对象变量或未设置块变量）。
很抱歉，但现在它甚至什么都没做。我想也许它与Sheet1 部分有关（因为这不是我用来测试的选项卡的名称），但改变它只会破坏它。如果我单步执行代码，它似乎正在工作，因为它对各种“If Then”语句的反应不同（即使我在电子表格上看不到任何事情发生），但它最终什么也没做。最后一步正确吗？还是在正确的位置？我知道您说过您无法对其进行测试，但我的电子表格并没有什么特别之处……实际上只是 D-K 列中的日期列表。
测试并更新了我认为是您的布局的代码。将 Set sht = Sheet1 替换为您的工作表。
我正在测试的工作表的名称是 Export 但是当我使用它而不是 Sheet1 时出现错误。但是，我希望它更通用，而不是取决于工作表的名称，所以我尝试了ActiveSheet，并且效果很好。老实说，它瞬间跑了。我一直在尝试的所有其他人都需要时间循环。
很高兴听到。将值添加到变量数组中总是比遍历工作表中的每个单元格更快。

【解决方案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，但您可以轻松地将其切换回来。

【讨论】：

感谢您的帮助，Scott，但我无法让您的代码正常工作。如果我按原样尝试，我会收到一个编译错误“当前范围内的重复声明”，它指向Dim rows as Long, i as Long 行。如果我使用与“rows”不同的词（如 xrows），我不会收到编译错误，但我会收到一个错误，指出当我尝试运行它时，下一行出现类型不匹配。跨度>
@Mike。您可能在代码的其他地方有一个变量声明为rows。如果是这种情况，您可以更改我对xrows 的所有引用，就像您开始做的那样，但您需要一直使用它。所以Dim xrows as Long、xrows = Selection.Rows、For i = xrows to 1 Step -1。否则它将继续引用您的原始行声明，这可能与我所做的不符。
这正是我认为可能是问题所在，因为当我试图在任何地方将其更改为大写 R 时，它一直在变回我。问题是，我在任何地方都找不到。我什至为整个项目搜索了 row ，但一无所获。是否有一些全球性的地方我应该看看该声明是否存在？此外，我确实使用了 xrows 的名字（幸运的是，我知道很多），但在下一行仍然出现了这个错误 - xrows = Selection.rows。我现在在想这个我找不到的行声明也搞砸了。
@Mike -> 哎呀，我搞砸了。该行应为“Selection.Rows.Count” 我忘了添加返回行数的Count 方法。不匹配是因为Rows 属性表示Range 对象，其中xrows 设置为Long 变量。我这样编辑了答案。对此感到抱歉......另外，最好避免声明与内置属性/方法同名的变量。这可能是 XL 不喜欢大写字母 R 的另一个原因...
好的，这有帮助，所以谢谢你......但现在它似乎没有做任何事情。我在循环中添加了一个MsgBox，因此我可以看到它正在查看正确的单元格，我注意到即使它看起来是循环的，它实际上是一遍又一遍地检查最后一行。老实说，我有点惊讶它在运行时并没有让我陷入无限循环。