Есть книга 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