Оптимизировать: Excel VBA Macro для удаления нижних строк объединенной ячейки

Question

У меня все работает нормально, но мучительно медленно. Первая функция, которая переименовывает некоторые ячейки, работает очень быстро, но цикл while, который удаляет определенные объединенные строки ячеек, занимает несколько минут для нескольких листов.

Вот соответствующий код:

Dim i As Long
Dim LastRow As Long

LastRow = Cells(Rows.Count, rowtofilter).End(xlUp).Row

'Search for merged cells and not "string1" in column2 and not "string2" in column4, replace text
For i = rowtofilter To LastRow
    If Range(ColumnLetter1 & i).MergeArea.Cells.Count > 1 And Range(ColumnLetter2 & i) <> "string1" And Range(ColumnLetter4 & i) <> "string2" Then
        Range(ColumnLetter3 & i).Value = "Merged Cells"
    End If
Next i

'Search for merged cells and not "string1" in column2 and not "string2" in column4, delete rows
i = LastRow - rowtofilter
Do While i > (rowtofilter - 1)
    If Range(ColumnLetter1 & i).Value = 0 And Range(ColumnLetter2 & i) <> "string1" And Range(ColumnLetter4 & i) <> "string2" Then
        Range(ColumnLetter1 & i).EntireRow.Delete
    End If
    i = i - 1
Loop

Answer 1

Если вы еще этого не сделали, добавьте application.screenupdating=false в начале и application.screenupdating=true в конце кода, чтобы ускорить процесс.

Затем, если все еще медленно, удалите все сразу:

Dim rgToDelete As Range

i = LastRow - rowtofilter
Do While i > (rowtofilter - 1)
    If Range(ColumnLetter1 & i).Value = 0 And Range(ColumnLetter2 & i) <> "string1" And Range(ColumnLetter4 & i) <> "string2" Then
        If rgToDelete Is Nothing Then 
             Set rgToDelete = Range(ColumnLetter1 & i) 
        Else 
             Set rgToDelete = Union(rgToDelete , Range(ColumnLetter1 & i))
        End If
    End If
    i = i - 1
Loop


rgToDelete .EntireRow.Delete

Answer 2

1. Вместо использования Rows.Count, работать только с UsedRange. Worksheet.UsedRange.Rows.Count
2. Скрыть лист при выполнении второго бита. Excel хочет обновить экран с каждой удаленной строкой. Скрывая лист, вы прекращаете эту ерунду. Worksheet.Visible = xlSheetVeryHidden
3. Если есть расчеты, основанные на удаляемых строках, отключите автоматические вычисления во время удаления. На самом деле, вы могли бы просто сделать это в любом случае. Это предотвратит пересчет Excel при каждом удалении. Application.Calculation = xlCalculationManual

Не забудьте снова включить все, когда закончите.

* Обратите внимание, что в приведенных выше примерах рабочий лист должен быть заменен ссылкой на любой рабочий лист, который вы используете.