Лучший VBA способ сжать список

Question

У меня есть несколько вопросов о следующем коде, который сжимает и форматирует список.

1. Я установил переменную endIndicator в качестве временного маркера для конца списка.Было бы лучше просто постоянно проверять текущий конец списка через мой ActiveSheet.UsedRange.Rows.Count + ActiveSheet.UsedRange.Rows(1).Row - 1?

2. Я попытался With ActiveCell.Offset(rowOffset) оператор в цикле удаления, который дает мне

   ошибка времени выполнения 424 Требуемый объект

   на второй итерации цикла.Я так понимаю, это связано с уничтожением предыдущего ряда.Есть ли соответствующий оператор With для использования в этом цикле?

3. Аналогичным образом я попытался With ActiveCell.EntireColumn для последних трех операторов и получил тот же результат.Я предполагаю по той же причине.Есть ли подходящее решение?

Вот код

Option Explicit

Sub Condense1()    
'Purpose : Condense list by removing unwanted rows    
'Requires: Column B row verbiage    
'          Column A row blank for unwanted row    
'Returns : Single compressed column of values wanted    

    Dim endIndicator As String
    Dim rowOffset As Long

    Worksheets(1).Activate          'Select Sheet
    Range("A1").Select              'Set offset base

    endIndicator = "zzzendozx"      'Assign unique value unlikely to be duplicated
                                    'Find last used row
    rowOffset = ActiveSheet.UsedRange.Rows.Count _
        + ActiveSheet.UsedRange.Rows(1).Row - 1
                                    'Temporarily mark next row as loop terminator
    ActiveCell.Offset(rowOffset, 0).Value = endIndicator

    rowOffset = 0                   'Reset offset pointer

                                    'For each row from top to loop terminator
    Do While ActiveCell.Offset(rowOffset).Value <> endIndicator
                                    ' Delete rows whose column "A" is empty
        If Len(ActiveCell.Offset(rowOffset).Value) < 1 Then
            ActiveCell.Offset(rowOffset).EntireRow.Delete
        Else
            rowOffset = rowOffset + 1   'Otherwise prepare to look at next row
        End If
    Loop
    ActiveCell.Offset(rowOffset).EntireRow.Delete   'Remove loop terminator row
    ActiveCell.EntireColumn.Delete                  'Remove Column A
    ActiveCell.EntireColumn.Font.Size = 14          'Set Font
    ActiveCell.EntireColumn.AutoFit                 'Set optimum column width

End Sub

Answer 1

Это может помочь:

Sub Kompressor()
    Dim nLastRow As Long, nFirstRow As Long, i As Long
    Set r = ActiveSheet.UsedRange

    nLastRow = r.Rows.Count + r.Row - 1
    nFirstRow = r.Row

    For i = nLastRow To nFirstRow Step -1
        With Cells(i, 1)
            If .Value = "" Then .EntireRow.Delete
        End With
    Next i
End Sub

Обратите внимание, что мы запускаем цикл в обратном направлении .
Код будет работать немного быстрее, если мы удалим только один раз.