VBA Entirerow.Delete 不会删除 For Each 中的最后一个单元格

问题描述

我有一些代码可以删除 Excel 中的行，如果它们比选定的日期旧。该函数有效，但不会删除最后一个值。

如果我运行此代码，例如：

Dim count As Long
count = 0
Dim searchRng As Range: Set searchRng = Range("Q9:Q5000")
Dim Cell As Range

For Each Cell In searchRng
    If ((Cell.Value < CDate(TextBoxDelete.Value)) And (Cell.Value <> "")) Then              
    
    count = count + 1
    
     Debug.Print ("Cell " & count & ": " & Cell.Value & " txtBox: " & TextBoxDelete.Value)      
    
     'Cell.EntireRow.Delete  ' This line deletes the Row                                                                    
    
End If

    Next Cell

如果我运行此代码，我会得到以下输出：

Cell 1: 03.03.2021 txtBox: 04.03.2021
Cell 2: 03.03.2021 txtBox: 04.03.2021
Cell 3: 03.03.2021 txtBox: 04.03.2021
Cell 4: 03.03.2021 txtBox: 04.03.2021

这是正确的，这些是比 TextBox.Value 旧的 4 个单元格

现在，当我在 DELETE 部分中使用相同的函数和注释时，输出如下所示：

Cell 1: 03.03.2021 txtBox: 04.03.2021
Cell 2: 03.03.2021 txtBox: 04.03.2021

代码是一样的，但你可以看到它现在只能找到 2 个值 - 而不是 4 个！

找到的 2 个单元格被删除，但其他 2 个单元格没有被删除。

有没有人遇到过类似的行为？

编辑：在回答部分的所有帮助之后，我想出了这个：

For j = searchRng.count To 1 Step -1
    If ((searchRng(j).Value < CDate(TextBoxDelete.Value)) And (searchRng(j).Value <> "")) Then
    
    count = count + 1
    
    Debug.Print ("Cell " & count & ": " & searchRng(j).Value & " txtBox: " & TextBoxDelete.Value)
     
    searchRng(j).EntireRow.Delete                                                                           ' Delete Call for the Row
     
    End If
     
    Next j

这是有效的代码还是有任何缺陷？运行它正是我需要的。

解决方法

您正在修改正在迭代的内容。所以一旦你删除了第一行，第二行就变成了你已经处理过的第一行，所以在原来的第 3 行继续迭代，现在是迭代中的第二个项目。

有同样的问题，但在 java 中有一些很好的答案 here。

如果使用循环，一般需要使用For i = x to 1 Step -1类型的循环来删除行。另一种方法是使用 Application.Union 建立一个删除范围，然后一次性删除所有内容。

您应该如何调整代码的示例如下（未经测试）；

Sub ExampleDelete()
    Dim SearchRng As Range: Set SearchRng = Range("Q9:Q5000")
    Dim i As Long,Cell As Range
    
    For i = SearchRng.Cells.count To 1 Step -1
        Set Cell = Application.WorksheetFunction.Index(SearchRng,i)
        If ((Cell.Value < CDate(TextBoxDelete.Value)) And (Cell.Value <> "")) Then
            Debug.Print ("Cell " & i & ": " & Cell.Value & " txtbox: " & TextBoxDelete.Value)
            'Cell.EntireRow.Delete  ' This line deletes the Row
        End If
    Next Cell
End Sub

您可以通过收集单元格然后一次删除它们来从上到下遍历您的范围：

Option Explicit

Sub test1()
    Dim toDel As Range,Cell As Range
    Dim searchRng As Range: Set searchRng = Range("Q9:Q5000")
    
    ' debug var; remove it and replace it further with TextBoxDelete.Value
    Dim txtBoxValue: txtBoxValue = #5/10/2021#
    
    For Each Cell In searchRng
        If Cell < CDate(txtBoxValue) And Not IsEmpty(Cell) Then
            'collect matched cells into toDel
            If toDel Is Nothing Then
                Set toDel = Cell
            Else
                Set toDel = Union(toDel,Cell)
            End If
         Debug.Print ("Cell " & toDel.Cells.count & ": " & Cell.Text & " txtbox: " & txtBoxValue)
        End If
    Next Cell
    ' next statement deletes all the rows at once
    If Not toDel Is Nothing Then toDel.EntireRow.Delete
End Sub

excel excel foreach