VBA For Next 循环无法正常工作的问题

Question

我正在努力思考一段过去对我有用的代码，但现在在不同的应用程序中不起作用。基本上，它需要删除包含特定列中信息的所有行，其余的保持不变。当我运行宏时，代码执行没有问题，但只是删除了一些带有值的行，而不是全部。当连续多次运行代码时，它最终会按预期进行，但这确实不方便。代码如下：

Sub Delete_Signoffed()

Dim rCell As Range
Dim iCol As Integer
Dim iRow As Integer


Worksheets("MilestoneDueDate").Activate
If ActiveSheet.AutoFilterMode Then Cells.AutoFilter
ActiveWindow.FreezePanes = False
Columns.EntireColumn.Hidden = False

If WorksheetFunction.CountA(Columns("A")) = 0 Then
    Columns("A").Delete
    Rows("1:6").Delete
End If

iCol = Cells.Find("Sign-Off By", LookAt:=xlWhole).Column

For iRow = 2 To Cells(Rows.Count, iCol).End(xlUp).Row
    Cells(iRow, iCol).Select
    If Not IsEmpty(Cells(iRow, iCol).Value) Then Rows(iRow).EntireRow.Delete
Next iRow

End Sub

源文件有一些格式问题，在分配iCol列值之前的一切都是为了修复格式，所以请忽略。 iRow 从 2 开始以避免删除文件头。

关于为什么 For 循环没有按预期工作的任何想法？

提前致谢！

Answer 1

希望以下内容对您的问题有所帮助：

1. 我更新了你的脚本
2. 添加了评论，以便您能够更好地理解它并能够在将来改进它

这里是：

Sub Delete_Signoffed()

'Goto CleanUp if there are errors
On Error GoTo CleanUp

Dim wsMilestoneDueDate As Worksheet

Dim rCell As Range
Dim iCol As Integer
Dim iRow As Integer

Set wsMilestoneDueDate = ActiveWorkbook.Worksheets("MilestoneDueDate")

'Disable temporarily Screen Updating
Application.ScreenUpdating = False

With wsMilestoneDueDate

    .Activate   'No need, but if you prefer you can

    'Activate Auto Filter
    If .AutoFilterMode Then Cells.AutoFilter

    'Remove FreezePanes
    ActiveWindow.FreezePanes = False

    'Unhide Columns
    .Columns.EntireColumn.Hidden = False

    'Delete Empty Columns/Rows if they are all empty
    If WorksheetFunction.CountA(.Columns("A")) = 0 Then
        Columns("A").Delete
        Rows("1:6").Delete
    End If

    'Get the last Column
    iCol = .UsedRange.Find("Sign-Off By", LookAt:=xlWhole).Column

    'Start Deleting but from the last to the first (Backward)
    For iRow = Cells(Rows.Count, iCol).End(xlUp).Row To 2 Step -1

        Set rCell = Cells(iRow, iCol)

        'Delete the entire row if it is NOT empty
        If Not IsEmpty(rCell.Value) Then
            'Deletion
            Rows(iRow).EntireRow.Delete
        End If
    Next iRow

End With

CleanUp:
    'Purge Memory
    Set wsMilestoneDueDate = Nothing
    Set rCell = Nothing

    'Restore Screen Updating
    Application.ScreenUpdating = True

End Sub

希望对你有所帮助。万事如意！

Answer 2

正如 cmets 中所述，您的代码中的缺陷不是向后循环

但我特此为您提供一个无需循环且仅使用一行的解决方案，这要归功于Range 对象的SpecialCells 方法，指定它以过滤具有某些“恒定”（即不是从公式派生）值的单元格

    Range(Cells(2, iCol), Cells(Rows.Count, iCol).End(xlUp)).SpecialCells(xlCellTypeConstants).EntireRow.Delete

这假设您始终在第 1 行下方至少有一个值

如果不是这样，那么只需添加一个检查：

    If Cells(Rows.Count, iCol).End(xlUp).Row > 1 Then Range(Cells(2, iCol), Cells(Rows.Count, iCol).End(xlUp)).SpecialCells(xlCellTypeConstants).EntireRow.Delete

在查看您的整个代码时，您应该采用良好的做法来避免 Select/Selection, Activate/ActiveXXX 模式和始终完全限定其工作表（如果不是工作簿）父对象的范围，如下所示：

Sub Delete_Signoffed()

    Dim iCol As Long

    With Worksheets("MilestoneDueDate") ' reference wanted sheet

        If .AutoFilterMode Then .Cells.AutoFilter
        ActiveWindow.FreezePanes = False

        .Columns.EntireColumn.Hidden = False

        If WorksheetFunction.CountA(.Columns("A")) = 0 Then
            .Columns("A").Delete
            .Rows("1:6").Delete
        End If

        iCol = .Range("A1", .Cells(1, .Columns.Count).End(xlToLeft)).Find("Sign-Off By", LookAt:=xlWhole, LookIn:=xlValues).Column

        .Range(.Cells(2, iCol), .Cells(.Rows.Count, iCol).End(xlUp)).SpecialCells(xlCellTypeConstants).EntireRow.Delete

    End With   

End Sub

如你所见

• 所有范围对象（Columns()、Rows、Range、Cells）都通过它们前面的那个点（.）引用Worksheets("MilestoneDueDate")

• iCol 被设置为在可能的最受限范围内运行 Find() 方法