Очень полезную ссылку дал slippyk, рекомендую ознакомиться обязательно.
К тому, что там написано, от себя добавлю следующее:
- Полезно для производительности не только читать/записывать ячейки с помощью двумерного массива. Более универсальный совет: избегать, по возможности, любых обращений в цикле к объектам библиотек VBA.
Worksheet
, Range
, Borders
и др. - это всё COM-объекты, а каждый вызов их методов/свойств - дополнительный оверхед.
Соответственно, если записываете ячейки массивом за один вызов .Range(...).Value = array
, а затем хотите отформатировать таблицу, установив форматы чисел, границы ячеек и др., то обрабатывайте ячейки тоже диапазонами. Если форматирование для разных колонок таблицы должно различаться, обрабатывайте каждую колонку как один диапазон. Но ни в коем случае в больших таблицах не обрабатывайте ячейки по одной.
- Отключив обновление экрана, обязательно гарантируйте восстановление режима работы Excel, чтобы ошибка при выполнении макроса не привела пользователя к пустому окну приложения. Он будет закрывать Excel через диспетчер задач и нехорошо выражаться в адрес программиста :) Используйте операторы "On Error".
Ниже прилагаю пример кода, демонстрирующий скорость заполнения листа миллионом значений (таблица 10000 строк на 100 столбцов).
Чтобы запустить код:
создайте книгу Excel и два листа в ней
откройте окно редактора VBA
переименуйте листы в "Sheet_1" и "Sheet_2"
на листе Sheet_1 можно ввести несколько числовых значений (вводя строку или дату, сможете увидеть впоследствии, как отреагирует макрос на ошибку)
создайте модуль и вставьте в него код макроса
выполните макрос (у меня примерно 1.5 сек.) и перейдите в окно Excel, чтобы посмотреть результаты
Option Explicit
Public Sub Test()
Dim i As Long, j As Long, sum As Long
Dim iLastRow As Long, iLastCol As Long
Dim src_data As Variant
Dim dst_data() As Variant
' установка обработчика ошибок
On Error GoTo lbl_error
' отключение функций, способных замедлить или приостановить работу макроса
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
' чтение исходных данных в двумерный массив Variant
With Sheet_1
iLastRow = .UsedRange.Row + .UsedRange.Rows.Count - 1
iLastCol = .UsedRange.Column + .UsedRange.Columns.Count - 1
src_data = .Range(.Cells(3, 3), .Cells(iLastRow, iLastCol)).Value
End With
' какая-нибудь обработка исходных данных (неважно какая)
sum = 0
For i = LBound(src_data, 1) To UBound(src_data, 1)
For j = LBound(src_data, 2) To UBound(src_data, 2)
sum = sum + CLng(src_data(i, j))
Next j
Next i
' формирование выходного массива данных 10 000 * 100 = 1 000 000 значений
ReDim dst_data(0 To 9999, 0 To 99)
For i = 0 To 9999
For j = 0 To 99
dst_data(i, j) = sum + i + j
Next j
Next i
' запись выходного массива в место назначения
With Sheet_2
.Range(.Cells(2, 2), .Cells(10001, 101)).Value = dst_data
End With
' форматирование выходной таблицы
With Sheet_2
' форматы первых трёх колонок
.Range(.Cells(2, 2), .Cells(10001, 2)).NumberFormat = "0.00"
.Range(.Cells(2, 3), .Cells(10001, 4)).HorizontalAlignment = xlRight
' границы на всю таблицу
With .Range(.Cells(2, 2), .Cells(10001, 101))
Call .BorderAround(xlContinuous, xlThin)
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
End With
End With
' перепрыгнуть блок обработки ошибок
GoTo lbl_finish
' обработчик ошибок
lbl_error:
Call MsgBox("Ошибка " & CStr(Err.Number) & ": " & Err.Description, vbCritical)
On Error Resume Next
' восстановить режим работы Excel
lbl_finish:
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
' показать сформированный лист
Sheet_2.Activate
End Sub
Application.ScreenUpdating=False
), и не забыть потом включить обратно. Вариант 2 - накопить изменения в двумерном массиве, а потом одной строкой скопировать его в нужный диапазон. Впрочем, можно и то, и другое одновременно.