Скорость работы макроса

Автор Electric, 12 января 2022, 17:50

Electric

Есть книга Excel, на первой странице "КЖ" содержится около пары тысяч строк с данными, моя цель скопировать непустые и незачеркнутые строки на третий лист в книге, начиная с 3 строки. Проверяю незачеркнутость по первой ячейке.

Я набросал такой код:

Спойлер

Sub copy_not_stricken()
    'Первая страница, откуда копируем
    Dim sourceWorksheet As Worksheet
    Set sourceWorksheet = ThisWorkbook.Worksheets("КЖ")
   
    'Страница куда копируем
    Dim targetWorksheet As Worksheet
    Set targetWorksheet = ThisWorkbook.Worksheets(3)
   
    'Вертикальный диапазон ячеек с названиями кабелей на первом листе
    Dim cable_names As Range
    Set cable_names = sourceWorksheet.Range("Маркировка_кабеля_по_проекту")
   
    'Подсчет общего числа строк в этом диапазоне
    Dim num_of_cable_rows As Long
    num_of_cable_rows = cable_names.SpecialCells(xlLastCell).Row
   
    'Переменная под ячейку в этом диапазоне
    Dim first_cell As Range
   
    'Переменная под номер строки
    Dim row_num As Long
       
    'Проход по строкам на листе и копирование незачеркнутых и непустых строк
    For Each first_cell In cable_names
        row_num = first_cell.Row
       
        'Если номер строки больше двух, первая ячейка не зачеркнута и не пустая - копируем
        If (row_num > 2) And (first_cell.Font.Strikethrough = False) And (first_cell.Value <> "") Then
           
            sourceWorksheet.Range(sourceWorksheet.Cells(row_num, 2), sourceWorksheet.Cells(row_num, 9)).Copy
           
            With targetWorksheet.Range(targetWorksheet.Cells(row_num, 2), targetWorksheet.Cells(row_num, 9))
                .PasteSpecial Paste:=xlPasteAllUsingSourceTheme
                .PasteSpecial Paste:=xlPasteColumnWidths
            End With
           
        End If
    Next first_cell
   
End Sub
[свернуть]

Работает это все крайне медленно. Копирование 1700 строк занимает продолжительное время, часто приводящее к зависанию Excel. Сама скорость копирования ненамного быстрее работы вручную.
Возможно ли как-то оптимизировать мой код для увеличения скорости? Может быть выбранный мной метод Copy неоптимален.  Или низкая скорость - это принципиальная особенность VBA и Excel?

Администратор

Написал вам два письма на почту с заголовком "Письмо с Форума по VBA, Excel и Word". Написал именно на почту, а не на форум.

Для начала можно отключить обновление монитора. Если много формул, можно ещё отключить формулы.
После работы кода обновление монитора само включится, поэтому можно не включать.

Sub Макрос()
   
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
   
    ' Здесь код макроса.
    ' ...
   
    Application.Calculation = xlCalculationAutomatic
   
End Sub