Проблемы с VBA For Next l oop не работает

Question

Я пытаюсь обернуть голову вокруг фрагмента кода, который работал для меня в прошлом и не работал сейчас в другом приложении. По сути, ему необходимо удалить все строки, содержащие информацию в указанном столбце c, а остальные оставить нетронутыми. Когда я запускаю макрос, код выполняется без проблем, а просто удаляет некоторые строки со значениями, а не все. При запуске кода несколько раз подряд он в конечном итоге делает то, что задумано, но на самом деле это не удобно. Вот код:

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 l oop не работает должным образом?

Заранее спасибо!

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

Как уже отмечалось в комментариях, недостаток в вашем коде не был зациклен назад

Но я тем самым даю вам решение без зацикливания и использования только одной строки, благодаря SpecialCells методу Range объекта указав его для фильтрации ячеек с некоторым «постоянным» (т.е. не производным от формул) значением

    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() в максимально ограниченном диапазоне возможных