Как ускорить работу макроса vba excel Excelka.ru - все про Ексель

Как ускорить работу макроса vba excel

Как ускорить работу макроса vba excel

Написал макрос для excel (на VBA) который обрабатывает данные и заносит их в таблицу (на отдельном листе).

Таблица довольно большая, поэтому макрос работает относительно значительное время. Мне почему-то кажется, что это связано с тем, что после каждой записи в ячейку excel выполняет какие-то действия по перерисовке листа и именно это значительно снижает скорость работы макроса.

Действительно ли это так? И если да, то как лучше всего оптимизировать процесс? Я думал про то, чтобы блокировать лист (перерисовка) до тех пор, пока все данные не будут внести, и лишь после этого разблокировать лист.

Прав ли я? И если да, то как это лучше реализовать?

Очень полезную ссылку дал slippyk, рекомендую ознакомиться обязательно.

К тому, что там написано, от себя добавлю следующее:

  1. Полезно для производительности не только читать/записывать ячейки с помощью двумерного массива. Более универсальный совет: избегать, по возможности, любых обращений в цикле к объектам библиотек VBA. Worksheet , Range , Borders и др. — это всё COM-объекты, а каждый вызов их методов/свойств — дополнительный оверхед.

Соответственно, если записываете ячейки массивом за один вызов .Range(. ).Value = array , а затем хотите отформатировать таблицу, установив форматы чисел, границы ячеек и др., то обрабатывайте ячейки тоже диапазонами. Если форматирование для разных колонок таблицы должно различаться, обрабатывайте каждую колонку как один диапазон. Но ни в коем случае в больших таблицах не обрабатывайте ячейки по одной.

  1. Отключив обновление экрана, обязательно гарантируйте восстановление режима работы Excel, чтобы ошибка при выполнении макроса не привела пользователя к пустому окну приложения. Он будет закрывать Excel через диспетчер задач и нехорошо выражаться в адрес программиста 🙂 Используйте операторы «On Error».

Ниже прилагаю пример кода, демонстрирующий скорость заполнения листа миллионом значений (таблица 10000 строк на 100 столбцов). Чтобы запустить код:

создайте книгу Excel и два листа в ней

откройте окно редактора VBA

переименуйте листы в «Sheet_1» и «Sheet_2»

на листе Sheet_1 можно ввести несколько числовых значений (вводя строку или дату, сможете увидеть впоследствии, как отреагирует макрос на ошибку)

создайте модуль и вставьте в него код макроса

выполните макрос (у меня примерно 1.5 сек.) и перейдите в окно Excel, чтобы посмотреть результаты

Как ускорить и оптимизировать код VBA

  1. Если в коде есть много всяких Activate и Select , тем более в циклах — следует немедленно от них избавиться. Как это сделать я писал в статье: Select и Activate — зачем нужны и нужны ли?
  2. Обязательно на время выполнения кода отключить:
    • автоматический пересчет формул . Чтобы формулы не пересчитывались при каждой манипуляции на листе во время выполнения кода — это может дико тормозить код, если формул много:

если печать производится внутри кода, то эту строку желательно вставить сразу после строки, выводящей лист на печать(при условии, что печать не происходит в цикле. В этом случае — по завершению цикла печати).
На всякий случай можно отключить отображение информации в строке статуса Excel (в каких случаях там вообще отображается информация и зачем можно узнать в статье: Отобразить процесс выполнения). Хоть это и не сильно поедает ресурсы — иногда может все же ускорить работу кода:

Главное, что следует помнить — все эти свойства необходимо включить обратно после работы кода . Иначе могут быть проблемы с работой внутри Excel. Например, если забыть включить автопересчет формул — большинство формул будут пересчитывать исключительно принудительным методом — Shift+F9. А если забыть отключить обновление экрана — то есть шанс заблокировать себе возможность работы на листах и книгах. Хотя по умолчанию свойство ScreenUpdating и должно возвращаться в True, если было отключено внутри процедуры — лучше не надеяться на это и привыкать возвращать все свойства на свои места принудительно. По сути все это сведется к нескольким строкам:

‘Возвращаем обновление экрана Application.ScreenUpdating = True ‘Возвращаем автопересчет формул Application.Calculation = xlCalculationAutomatic ‘Включаем отслеживание событий Application.EnableEvents = True

Как такой код выглядит на практике. Предположим, надо записать в цикле в 10 000 строк значения:

Sub TestOptimize() ‘отключаем обновление экрана Application.ScreenUpdating = False ‘Отключаем автопересчет формул Application.Calculation = xlCalculationManual ‘Отключаем отслеживание событий Application.EnableEvents = False ‘Отключаем разбиение на печатные страницы ActiveWorkbook.ActiveSheet.DisplayPageBreaks = False ‘Непосредственно код заполнения ячеек Dim lr As Long For lr = 1 To 10000 Cells(lr, 1).Value = lr ‘для примера просто пронумеруем строки Next ‘Возвращаем обновление экрана Application.ScreenUpdating = True ‘Возвращаем автопересчет формул Application.Calculation = xlCalculationAutomatic ‘Включаем отслеживание событий Application.EnableEvents = True End Sub

Разрывы печатных страниц можно не возвращать — они тормозят работу в любом случае.
Следует избегать циклов, вроде Do While для поиска последней ячейки . Часто такую ошибку совершают начинающие. Куда эффективнее и быстрее вычислять последнюю ячейку на всем листе или в конкретном столбце без этого тормозного цикла Do While. Я обычно использую

другие варианты определения последней ячейки я детально описывал в статье: Как определить последнюю ячейку на листе через VBA?

Для более опытных пользователей VBA я приведу несколько решений по оптимизации кодов в различных ситуациях:

    Самая хорошая оптимизация кода, если приходится работать с ячейками листа напрямую, обрабатывать их и, возможно, изменять значения, то быстрее все обработки делать в массиве и разом выгружать на листе. Например, код выше по заполнению ячеек номерами будет в этом случае выглядеть так:

Sub TestOptimize_Array() ‘Непосредственно код заполнения ячеек Dim arr, lr As Long ‘запоминаем в массив одним махом все значения 10000 строк первого столбца arr = Cells(1, 1).Resize(10000).Value ‘если нужно заполнение для двух и более столбцов ‘arr = Cells(1, 1).Resize(10000, 2).Value ‘или ‘arr = Range(Cells(1, 1),Cells(10000, 2)).Value ‘или автоматически вычисляем последнюю ячейку и заносим в массив данные, начиная с ячейки А3 ‘llastr = Cells(Rows.Count, 1).End(xlUp).Row ‘последняя ячейка столбца А ‘arr = Range(Cells(3, 1),Cells(llastr, 2)).Value For lr = 1 To 10000 arr(lr,1) = lr ‘заполняем массив порядковыми номерами Next ‘Выгружаем обработанный массив обратно на лист в те же ячейки Cells(1, 1).Resize(10000).Value = arr End Sub

Но здесь следует учитывать и тот момент, что большие массивы могут просто вызвать переполнение памяти. Наиболее актуально это для 32-битных систем, где на VBA и Excel выделяется памяти меньше, чем в 64-битных системах

  • Если используете быстрый ЕСЛИ — IIF , то замените его на IF . Then . Else
  • Так же лучше вместо Switch() и Choose() применить тот же IF . Then . Else
  • В большинстве случаев проверять строку на «не пусто» лучше через Len() , чем прямое сравнение с пустотой: Len(s)=0 вместо s = «» . Связано с тем, что работа со строками значительно медленнее, чем с числовыми данными
  • Не применять объединение строк без необходимости. Например, s = «АВ» , будет быстрее, чем: s =»А» & «В»
  • Не применять сравнение текстовых величин напрямую. Лучше применить встроенную функцию StrComp:
    If s <> s1 Then будет медленнее, чем
    If StrComp(s, s1, vbBinaryCompare) = 0
    и тем более, если при сравнении необходимо не учитывать регистр:
    If LCase(s) <> LCase(s1) Then будет медленнее, чем
    If StrComp(s, s1, vbTextCompare) = 0
  • Циклы For … Next в большинстве случаев работает быстрее, чем цикл Do . Lоор
  • Избегать присвоения переменным типа Variant . Хоть соблазн и велик — этот тип забирает много памяти и в дальнейшем замедляет работу кода. Так же для объектных переменных следует избегать по возможности безликого глобального типа Object и применять конкретный тип:

    Как ускорить работу макроса vba excel

    Ускоряем работу VBA в Excel

    Предисловие

    Так уж сложилось, что на сегодняшний день много кому приходится работать(писать макросы) на VBA в Excel. Некоторые макросы содержат сотни строк кода, которые приходится выполнять каждый день (неделю, месяц, квартал и так далее) и, при этом, они занимают изрядное количество времени. Вроде бы и и процесс автоматизирован и человеческого вмешательства не нужно, но время, занимаемое выполнением макроса, может охватывать десятки минут, а то и несколько часов. Время, как говориться, — деньги и в этом посте я постараюсь значительно ускорить время выполнения Вашего макроса и, возможно, это положительно скажется на ваших делах, а в итоге и деньгах.

    Перед началом работы

    Перед тем, как перейти прямо к сути, я хотел бы обратить внимание на пост: Несколько советов по работе с VBA в Excel. В частности, в блоке “Ускорение работы макросов” есть полезные примеры кода, которые стоит использовать вместе с моими советами по ускорению работы, для достижения максимального результата.

    Ускоряем работу макроса

    Итак, к сути… Для того что бы реально ускорить работу VBA в Ecxel нужно понимать, что обращение к ячейке на листе — занимает значительно время. Если Вы хотите записать в ячейку одно значение, то это не займет значительного времени, но если Вам потребуется записать(прочитать, обратиться) к тысячам ячеек, то это потребует гораздо большего времени. Что же делать в таких случаях? На помощь приходят массивы. Массивы хранятся в памяти, а операции в памяти VBA выполняет в сотни, а то и в тысячи раз быстрее. Поэтому, если у Вас в данных тысячи, сотни тысяч значений, то время выполнения макроса может занимать от нескольких минут до нескольких часов, а если эти данные перенести в массив, то выполнение макроса может сократиться до нескольких секунд (минут).

    Я наведу пример кода и в комментариях объясню что к чему, так будет яснее. К тому же, могут пригодиться некоторые строки кода, не относящееся прямо к процессу ускорения.

    Предположим, что у нас есть данные на “Лист1” (“Sheet1”). Данные содержаться в 50 колонках (колонки содержат названия) и 10 000 строк. К примеру, нам нужно в последнюю колонку внести значение, которое равно значению во второй колонке, деленное на значение в третьей колонке (начиная со 2-й строки, так как первая содержит заглавие). Потом мы возьмем первые 10 колонок и скопируем их на “Лист2” (“Sheet2”), для дальнейшей обработки (для других потребностей). Пусть пример и банальный, но, как мне кажется, он может отобразить всю суть данного поста.

    В данном примере массив заполняется указанным диапазоном. Если у нас будет явно заданный двумерный массив, то скопировать его значение на лист можно таким образом:

    Заключение

    Большинство операций над данными можно выполнять в массиве, при этом, отображать на лист только результат. Иногда целесообразным бывает показать результат на лист, потом выполнить некоторые действия (например, сортировку) и снова загрузить данные в массив.

    Для меня было большой неожиданностью ускорения работы макроса за счет массивов, так как данные на листах, на самом деле, итак представляют собой двумерный массив. Но, оказывается, обращение к памяти происходит гораздо быстрей, чем к ячейкам на листе.

    Как ускорить работу макроса vba excel

    Всем доброго времени . Продолжаются попытки хоть как то уменьшить размер и увеличить скорость работы моих огромных файлов.В свете этого была предпринята попытка написать макрос вставки формул в ячейки, копирования и вставки значений с последующим уничтожением нулей(спасибо Ярославу за макрос).Получился вот такой вот монстр ъ

    200?’200px’:»+(this.scrollHeight+5)+’px’);»> Sub СУММПР_1()
    Dim lLastRow As Long
    Dim lLastCol As Long

    lLastCol = Cells(31, Columns.Count).End(xlToLeft).Column

    Sheets(«состав»).Range(«B1»).FormulaLocal = «=СУММПРОИЗВ(План!$G$18:$I$1000*(План!$C$18:$C$1000=состав!B$31))» ‘вставляем формулу в 1 строку
    Range(«B1»).Select
    Application.CutCopyMode = False
    Selection.AutoFill Destination:=Range(Cells(1, 2), Cells(1, lLastCol)), Type:=xlFillDefault ‘копируем на весь диапазон
    Range(Cells(1, 2), Cells(1, lLastCol)).Select
    Selection.Copy ‘ копируем
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False ‘вставляем значения

    Sheets(«состав»).Range(«B2»).FormulaLocal = «=СУММПРОИЗВ(План!$P$18:$GA$800*(План!$P$16:$GA$16=»»СБ»»)*(План!$P$15:$GA$15=состав!$A2)*(состав!B$31=План!$C$18:$C$800))» ‘вставляем формулу в 2 строку
    Range(«B2»).Select
    Selection.AutoFill Destination:=Range(«B2:B29»), Type:=xlFillDefault
    Range(«B2:B29»).Select
    Selection.AutoFill Destination:=Range(Cells(2, 2), Cells(29, lLastCol)), Type:=xlFillDefault
    Range(Cells(2, 2), Cells(29, lLastCol)).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False ‘вставляем значения

    Sheets(«состав»).Range(«B30»).FormulaLocal = «=СУММПРОИЗВ(План!$GB$19:$GB$1000*(План!$C$19:$C$1000=состав!B$31))» ‘вставляем формулу в 30 строку
    Range(«B30»).Select
    Application.CutCopyMode = False
    Selection.AutoFill Destination:=Range(Cells(30, 2), Cells(30, lLastCol)), Type:=xlFillDefault ‘копируем на весь диапазон
    Range(Cells(30, 2), Cells(30, lLastCol)).Select
    Selection.Copy ‘ копируем
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False ‘вставляем значения

    Dim sh As Worksheet, r As Range
    If ActiveWindow.SelectedSheets.Count > 1 Then ‘убираем нули после спецвставка( код от Ярослава)
    For Each sh In ActiveWindow.SelectedSheets
    Set r = sh.UsedRange
    r.Replace 0, «», xlWhole
    Next
    Else
    If MsgBox(«Заменить 0 во всей книге?», vbYesNo) = vbNo Then
    If Selection.Count = 1 Then Set r = ActiveSheet.UsedRange Else Set r = Selection
    r.Replace 0, «», xlWhole
    Else
    For Each sh In ActiveWorkbook.Sheets
    Set r = sh.UsedRange
    r.Replace 0, «», xlWhole
    Next
    End If
    End If
    End Sub

    2. Убрать ненужные Select. Например вместо

    200?’200px’:»+(this.scrollHeight+5)+’px’);»> Sub СУММПР_2()
    ‘ t = Timer
    Dim lLastRow As Long

    Dim lLastCol As Long
    Dim data, result, lr As Long, i As Long, j As Long, k As Long, d As Long
    Dim sh1 As Worksheet, sh2 As Worksheet
    Set sh1 = ThisWorkbook.Sheets(«План»)
    Set sh2 = ThisWorkbook.Sheets(«состав»)
    lLastCol = Cells(31, Columns.Count).End(xlToLeft).Column
    With sh2
    .Range(«B1:AG30»).ClearContents
    lr = sh1.Cells(Rows.Count, 2).End(xlUp).Row
    data = sh1.Range(«a15:gb» & lr).Value
    ReDim result(UBound(data) — 1, UBound(data, 1) — 1)

    For i = 4 To UBound(data)
    For j = 2 To 33 ‘по столбцам b31:ag31
    If data(i, 3) = .Cells(31, j) Then
    ‘Вместо формулы для 1-й строки
    result(0, j — 2) = result(0, j — 2) + data(i, 7) + data(i, 8) + data(i, 9)
    ‘Вместо формул для диапазона b2:ag29
    For d = 2 To 29 ‘по строкам с датами на листе состав
    For k = 16 To 183 ‘по столбцам $P$18:$GA$800 на листе план
    If data(2, k) = «СБ» And data(1, k) = .Cells(d, 1) Then
    result(d — 1, j — 2) = result(d — 1, j — 2) + data(i, k)
    End If
    Next k
    Next d
    ‘Вместо формулы для 30-й строки
    result(29, j — 2) = result(29, j — 2) + data(i, 184)
    End If
    Next j
    Next i
    .Range(«B1:AG30») = result
    End With
    ‘Дальше ничего не трогала
    Dim sh As Worksheet, r As Range
    If ActiveWindow.SelectedSheets.Count > 1 Then ‘убираем нули после спецвставка( код от Ярослава)
    For Each sh In ActiveWindow.SelectedSheets
    Set r = sh.UsedRange
    r.Replace 0, «», xlWhole
    Next
    Else
    If MsgBox(«Заменить 0 во всей книге?», vbYesNo) = vbNo Then
    If Selection.Count = 1 Then Set r = ActiveSheet.UsedRange Else Set r = Selection
    r.Replace 0, «», xlWhole
    Else
    For Each sh In ActiveWorkbook.Sheets
    Set r = sh.UsedRange
    r.Replace 0, «», xlWhole
    Next
    End If
    End If
    ‘ Debug.Print Timer — t
    End Sub

    Сейчас найти бесплатный SQL Server не проблема

    узкое место в расчете, остальное не значимо

    200?’200px’:»+(this.scrollHeight+5)+’px’);»> Sub СУММПР_1()
    Dim t As Single: t = Timer

    Dim lLastRow As Long
    Dim lLastCol As Long

    lLastCol = Cells(31, Columns.Count).End(xlToLeft).Column

    Sheets(«состав»).Range(«B1»).FormulaLocal = «=СУММПРОИЗВ(План!$G$18:$I$1000*(План!$C$18:$C$1000=состав!B$31))» ‘вставляем формулу в 1 строку
    Range(«B1»).Select
    Application.CutCopyMode = False
    Selection.AutoFill Destination:=Range(Cells(1, 2), Cells(1, lLastCol)), Type:=xlFillDefault ‘копируем на весь диапазон
    Range(Cells(1, 2), Cells(1, lLastCol)).Select
    Selection.Copy ‘ копируем
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False ‘вставляем значения

    Debug.Print «1): » & Timer — t: t = Timer

    ‘Sheets(«состав»).Range(«B2»).FormulaLocal = _
    «=СУММПРОИЗВ(План!$P$18:$GA$800*(План!$P$16:$GA$16=»»СБ»»)*(План!$P$15:$GA$15=состав!$A2)*(состав!B$31=План!$C$18:$C$800))» ‘вставляем формулу в 2 строку

    Как ускорить работу макроса vba excel

    Сообщения: 306
    Благодарности: 3

    ——-
    Забудем боль, забудем страх —
    И только ветер в парусах!

    Сообщения: 306
    Благодарности: 3

    ——-
    Забудем боль, забудем страх —
    И только ветер в парусах!

    Сообщения: 25081
    Благодарности: 7288

    Сообщения: 306
    Благодарности: 3

    ——-
    Забудем боль, забудем страх —
    И только ветер в парусах!

    Сообщения: 25081
    Благодарности: 7288

    В данном случае Collection из VBA немного отличается от Dictionary из VBScript в сторону упрощения, но каких-то сложностей там нет: откройте редактор VBA, нажмите F2, наберите в поиске «Collection», нажмите «Enter», выберете класс Collection из библиотеки VBA, в правом окне увидите Members of ‘Collection’ — все члены класса, выделив конкретный член класса — внизу увидите его описание.

    Сообщения: 306
    Благодарности: 3

    Заключается в том, что: есть список, есть база. Надо узнать есть ли записи из списка в базе.

    А теперь как работает мой код.
    Загружаем в 2 массива(arr1 из базы, arr2 c листа).
    Берём arr1 и проверяем каждый номер по тому по arr2. Причем проверяем входимость.
    Если есть в элементе arr1 «СБ» тогда проверяем, есть ли в текущем элементе arr2 символ «-«, Если есть, то в переменную m записываем все что до черточки., проверяем есть ли текущее arr1 + «СБ», дальше сверяем 2 столбца в arr1, и если они равны, то тогда в arr2 пишем значение arr1, если нет, то пишем что «нет страниц» вот этот кусок кода

    Читать еще:  Как в эксель добавить файл эксель
  • Ссылка на основную публикацию