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

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

Чем больше познаём мы макросы, тем интересней выгледят наши программы. А бывает, что их выполнение происходит очень долго, при сложных и долгих математических расчётах или составлении каких-то отчётов и табилц. В ходе выполнения макроса на мониторе происходит мелькание различных окон, открытие и закрытие книг, и прочая светомузыка. Для того чтобы этого не происходило, и чтобы время выполнение нашего макроса сократить раз в 100, можно воспользоваться командами описанные ниже.

Application.ScreenUpdating

Application.ScreenUpdating - отвечает за обновление экрана и может принимать два значения - False (обновление экрана отключено) и True (обновление экрана включено). В коде это обычно прописывается в том месете, где происходит мелькание различных окон или видно как производится расчёт и происходит заполнение таблицы. Ниже показан пример заполнения ячеек, и данную команду вставили в начало и конец макроса, т.е. сначала отключаем обновление экрана, а потом включаем обновление экрана. При такой записи мы не увидим процесс заполнения ячеек. А вот если убрать эти команды, то мы сможем наблюдать за процессом заполнения этих ячеек.

Sub Primer()

Application.ScreenUpdating = False

For a = 1 To 100

For b = 1 To 100

Cells(a, b) = "Пример"

Next b

Next a

Application.ScreenUpdating = True

End Sub

Application.Calculation

Application.Calculation - отвечает за автоматический расчёт в книге Excel и может принимать два значения - xlCalculationManual(ручной расчёт) и xlCalculationAutomatic (автоматический расчёт - по умолчанию установлен в Excel). Но тут есть одна осторожность, если вы перевели Excel в ручной расчёт, и в макросе произошла ошибка и он так и не выполнился до конца - т.е. не включился автоматический расчёт формул, то все ваши вычисления в дальнейшем будут в пустую. Так как формулы не будут автоматически пересчитываться, Excel превратиться в обычную таблицу. Но данная команда играет одну из основных ролей в быстроте выполнеия макроса. Вообщем лучше сделать код, который исключает ошибки, чтобы макрос полюбому выполнился и Excel перевёлся в автоматический расчёт. Если у Вас имеется большая таблица с многочисленными формулами, и часть вычислений вы производите при помощи макросов, то для быстроты выполнения расчётов разумно в начало и конец кода поместить команду Application.Calculation.

Sub Primer2()

Application.Calculation = xlCalculationManual

...................

...................

...................

Application.Calculation = xlCalculationAutomatic

End Sub

Application.EnableEvents

Application.EnableEvents - команда отвечающая за выполнение сторонних событий. Эту команду мы уже затрагивали в этом уроке. И она также может принимать два значения - это False (отключить собтие) и True (включить выполнение промежуточных событий). Но теперь ещё известно, что она играет значительную роль в скорости выполнения некоторых кодов макроса. Пример можно взять из Урока №23.

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False

Target.Cells = "Привет"

Application.EnableEvents = True

End Sub

ActiveSheet.DisplayPageBreaks

ActiveSheet.DisplayPageBreaks - отображение границ листа. Может принимать два значения - False (отключить отображение границ) и True (включить отображение границ). Не знаю как это помогает на скорости выполнения макроса, лично я этого не ущутил, но некоторые говорят, что помогает. Я вообще не люблю когда отображаются границы листа, мне кажется, что это нужно только при распечатке. Помещать этот код можно в начало и конец макроса.

Private Sub Worksheet_Change(ByVal Target As Range)

ActiveSheet.DisplayPageBreaks = False

.........................

.........................

.........................

ActiveSheet.DisplayPageBreaks = True

End Sub

Application.DisplayStatusBar

Application.DisplayStatusBar - строка состояния. Может принимать два значения - False (отключить строку состояния) и True (включить строку состояния). При выполнении макросов в строке состояния отображаются все происходяще события. Для того чтобы не тратить время на просчёт событий и прорисовку их в статусбаре, отключаем её на время выполнения макроса, и включаем её когда макрос закончил выполняться.

Private Sub Worksheet_Change(ByVal Target As Range)

Application.DisplayStatusBar = False

.........................

.........................

.........................

Application.DisplayStatusBar = True

End Sub

Application.DisplayAlerts

Application.DisplayAlerts - команда отвечающая за события в Excel. Может принимать два значения - False (отключаем запросы Excel) и True (включаем события Excel). Это чень интересная и полезная команда при помощи которой можно отключить запросы Excel, например, чтобы он не спрашивал нужно ли сохранить изменения в книге, или отключить запрос на совместимость версий Excel. Ниже приведён пример, в котором книга закрывает сама себя, при этом независимо от того внесли вы изменения или нет в книгу, при закрытии книги вам не поступит запрос "Сохранить изменения", а книга просто закроется без сохранения и уведомления пользователя.

Sub Primer()

Application.DisplayAlerts = False

ThisWorkbook.Close

Application.DisplayAlerts = True

End Sub

Глобальное ускорение

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

sub Primer()

Application.ScreenUpdating = False

Application.Calculation = xlCalculationManual

Application.EnableEvents = False

Application.DisplayStatusBar = False

Application.DisplayAlerts = False

.........................

.........................

.........................

.........................

Application.ScreenUpdating = True

Application.Calculation = xlCalculationAutomatic

Application.EnableEvents = True

Application.DisplayStatusBar = True

Application.DisplayAlerts = True

End Sub

Скрытые перемещения

Я решил выделить отдельный урок, в котором будут описаны относительные команды скрытых перемещений по книге. Например каким образом возможно выполнить перемещение курсора на 3 столбца влево и на 6 строк вниз относительно активной ячейки. Это бывает очень удобно когда вы работаете с одними и теми же данными, с одинаковыми таблицами, из которых Вам надо выделить только определённые значения, скопировать их или наоборот оставить только их, а всё остальное удалить. При этом у Вас всё время выполняется одна и таже операция, которая уже надоела. Почему бы не написать готовый макрос, который будет работать и опираться на определённую ячейку таблицы - активную ячейку. Именно это я и решил собрать всё в одном уроке - Скрытые перемещения.

Относительные перемещения

Рассмотрим команду относительного перемещения, которая называется:

Offset(RowOffset, ColumnOffset)

RowOffset - это на сколько строк вверх или вниз необходимо сделать перемещение. Может принимать как положительные значения (при перемещении вниз), так и отрицательные значения (при перемещении вверх);
ColumnOffset - это на сколько столбцов влево или вправо необходимо сделать перемещение. Может принимать как положительные значения (при перемещении вправо), так и отрицательные значения (при перемещении влево);

Sub Primer()

ActiveCell.Offset(0, 2).Select '1

ActiveCell.Offset(4, 0).Select '2

ActiveCell.Offset(-2, 0).Select '3

ActiveCell.Offset(0, -2).Select '4

End Sub

В первом случае курсор выделит ячеку находящуюся на 2 ячейки вправо от активной ячейки. Во втором случае выделится ячейка находящаяся на 4 строки вниз от предыдущей - активной ячейки. В третьем случае выделится ячейка находящаяся на две строки выше от предыдущей - активной ячейки. И в последнем случае выделится ячейка находящаяся на два столбца влево от предыдущей - активной ячейки.

В следующем примере показано как выделить столбец находящийся на два столбца правее от 4 столбца ("D"). Вместо цифры 4 можно использовать какую-то переменную, относительно которой уже будет происходить выполнение Вашего макроса.

Sub Primer()

Columns(4).Offset(0, 2).Select

End Sub

Перемещаемся по листам не зная их имён

Иногда возникает необходимость выполнить перемещение по листам, но при этом их имена постоянно меняются или Вы делаете такую программу, в которой Вы заранее не знаете имена листов, но перемещаться в ней по этим листам как-то надо. Для этого можно воспользоваться записью относительной:

Sheets(X)

Sheets - это лист;
(X) - это номер листа;

Ниже на примере показано как можно выделить лист №2, и не важно какое у него имя, второй по счёту лист будет выделен:

Sub Primer()

Sheets(2).Select

End Sub

Лист можно не только выделить, но и перименовать и дальше испоьлзовать в программе ваше имя.

Sub Primer()

Sheets(2).Name = "Пример"

End Sub

Крайние перемещения

Возможно кто-то уже задавался вопросом: "Как определить край таблицы или последний заполненный столбец, строку?" Вот тут я и покажу как определить последнюю заполненную ячейку. Зная эту ячейку можно определить конечную координату таблицы, которую в последствии можно успешно обработать. Ниже показан пример выделения конечных ячеек относительно текущей.

Sub Primer()

Selection.End(xlToRight).Select '1

Selection.End(xlUp).Select '2

Selection.End(xlToLeft).Select '3

Selection.End(xlDown).Select '4

End Sub

1 - это выделение крайней правой яейки;
2 - это выделение самой верхней ячейки;
3 - это выделение крайней левой ячейки;
4 - это выделение нижней заполненной ячейки;

При помощи этих команд можно не только выделять ячейки, но и сразу заносить в них данные без предварительного перемещения в них курсора, например:

Sub Primer()

Selection.End(xlToRight) = "Пример"

End Sub

Выделения относительно активной ячейки

Выделить вниз до первой или последней заполненной ячейки (равносильно нажатию Ctrl+Shift+Down)

Sub CtrlShiftDown()

Range(ActiveCell, ActiveCell.End(xlDown)).Select

End Sub

Выделить вверх до первой или последней заполненной ячейки (равносильно нажатию Ctrl+Shift+Up)

Sub CtrlShiftUp()

Range(ActiveCell, ActiveCell.End(xlUp)).Select

End Sub

Выделить вправо до первой или последней заполненной ячейки (равносильно нажатию Ctrl+Shift+Right)

Sub CtrlShiftRight()

Range(ActiveCell, ActiveCell.End(xlToRight)).Select

End Sub

Выделить влево до первой или последней заполненной ячейки (равносильно нажатию Ctrl+Shift+Left)

Sub CtrlShiftLeft()

Range(ActiveCell, ActiveCell.End(xlToLeft)).Select

End Sub

Выделить текущую область (выделяется диапазон неразрывно заполненных ячеек - равносильно нажатию кнопок Ctrl+Shift+*)

Sub CtrlShiftUmn()

ActiveCell.CurrentRegion.Select

End Sub

Выделить активную область (происходит выделение всего заполненного диапазона Ctrl+Shift+Home, End, Home)

Sub CtrlShiftHome()

Range(Range("A1"), ActiveCell.SpecialCells(xlLastCell)).Select

End Sub

Выделить смежные (заполненные прилегающие к активной ячейке) ячейки в столбце с активной ячейкой

Sub SelectActiveColumn()

Dim TopCell As Range

Dim BottomCell As Range

If IsEmpty(ActiveCell) Then Exit Sub

On Error Resume Next

If IsEmpty(ActiveCell.Offset(-1, 0)) Then Set TopCell = _

ActiveCell Else Set TopCell = ActiveCell.End(xlUp)

If IsEmpty(ActiveCell.Offset(1, 0)) Then Set BottomCell = _

ActiveCell Else Set BottomCell = ActiveCell.End(xlDown)

Range(TopCell, BottomCell).Select

End Sub

Выделить смежные ячейки в строке с активной ячейкой

Sub SelectActiveRow()

Dim LeftCell As Range

Dim RightCell As Range

If IsEmpty(ActiveCell) Then Exit Sub

On Error Resume Next

If IsEmpty(ActiveCell.Offset(0, -1)) Then Set LeftCell = _

ActiveCell Else Set LeftCell = ActiveCell.End(xlToLeft)

If IsEmpty(ActiveCell.Offset(0, 1)) Then Set RightCell = _

ActiveCell Else Set RightCell = ActiveCell.End(xlToRight)

Range(LeftCell, RightCell).Select

End Sub

Выделить весь активный столбец

Sub SelectionEntireColumn()

Selection.EntireColumn.Select

End Sub

Выделить всю активную строку

Sub SelectEntireRow()

Selection.EntireRow.Select

End Sub

Выделить рабочий лист

Sub SelectEntireSheet()

Cells.Select

End Sub

Выделить следующую пустую ячейку снизу

Sub CellNextDown()

ActiveCell.Offset(1, 0).Select

Do While Not IsEmpty(ActiveCell)

ActiveCell.Offset(1, 0).Select

Loop

End Sub

Выделить следующую пустую ячейку справа

Sub CellNextRight()

ActiveCell.Offset(0, 1).Select

Do While Not IsEmpty(ActiveCell)

ActiveCell.Offset(0, 1).Select

Loop

End Sub

Выделение от первой непустой до последней непустой ячеек в строке

Sub SelectFirstToLastInRow()

Dim LeftCell As Range

Dim RightCell As Range

Set LeftCell = Cells(ActiveCell.Row, 1)

Set RightCell = Cells(ActiveCell.Row, 256)

If IsEmpty(LeftCell) Then Set LeftCell = LeftCell.End(xlToRight)

If IsEmpty(RightCell) Then Set RightCell = RightCell.End(xlToLeft)

If LeftCell.Column = 256 And RightCell.Column = 1 Then ActiveCell. _

Select Else Range(LeftCell, RightCell).Select

End Sub

Выделение от первой непустой до последней непустой ячеек в столбце

Sub SelectFirstToLastInColumn()

Dim TopCell As Range

Dim BottomCell As Range

Set TopCell = Cells(1, ActiveCell.Column)

Set BottomCell = Cells(16384, ActiveCell.Column)

If IsEmpty(TopCell) Then Set TopCell = TopCell.End(xlDown)

If IsEmpty(BottomCell) Then Set BottomCell = BottomCell.End(xlUp)

If TopCell.Row = 16384 And BottomCell.Row = 1 Then ActiveCell. _

Select Else Range(TopCell, BottomCell).Select

End Sub

Относительные формулы

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

Sub Primer()

Cells(4, 5) = "=RC[-3]+RC[-1]"

Cells(5, 5) = "=R[-3]C+R[-1]C"

End Sub

R - это строка, от слова Row;
C - это столбец, от слова Column;

В квадратных скобках указано на какое количество столбцов или строк необходимо переместится от заданной ячейки. Принцип отчёта такой же как и в команде рассмотренной самой первой в этом уроке - Offset. И как видно на примере, значения в квадратных скобках могут быть как отрицательные так и положительные.

В первом примере показано, что сумма в ячейке Cells(4, 5) равна сумме двух ячеек, одна из которых находится на третьем столбце влево от заданной ячейки, а другая на один столбец влево от заданной ячейки, при этом строка остаётся неизменной. На втором примере всё аналогично, только тут уже столбец остаётся неизменным а меняются строки.

Столбцы и строки

В этом пункте я расскажу как правильно работать со строками и столбцами. Каким образом можно выделить одну строку, две или несколько строк, и тоже самое со столбцами.

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

Rows(6).Select 'Строка

Columns(6).Select 'Столбец

Это самая простая запись не требующая никаких кавычек, Вы просто указываете номер строки или столбца и дальше делаете с ней что угодно, например закрасить в синий цвет:

Rows(6).Interior.ColorIndex = 5 'Строка

Columns(6).Interior.ColorIndex = 5 'Столбец

Если Вам необходимо выделить более одной строки или столбца, то можно воспользоваться следующей записью:

Rows("2:2").Select 'Строка

Columns("B:B").Select 'Столбец

Такая запись выделяет только одну строку и только один столбец.
А вот если записать так:

Rows("2:5").Select 'Строка

Columns("B:F").Select 'Столбец

то мы сможем обработать целый диапазон строк и столбцов, но он сплошной. Если мы хотим обработать разные строки, например 1, 4, 6-8, и разные столбцы, например B, D, F-G, то запись необходимо произвести следующим образом:

Range("1:1,4:4,6:8").Select 'Строка

Range("B:B,D:D,F:G").Select 'Столбец

При такой записи у нас получается уже диапазон. И умногих возник вопрос: "Каким образом можно одновременно выделить и строки и столбцы?". Пример ниже выделяет одновременно 8 строчку и столбец D:

Range("D:D,8:8").Select

А этот пример выделяет сразу несколько строк и столбцов одновременно:

Range("B:B,D:D,3:6,9:9").Select

Error. Обработка ошибок

Ну вот и пришёл тот долгожданный день, когда Вы задумались об обработке ошибок. Хорошо когда в программах работаете только Вы, и Вы знаете куда в ней можно нажать, а куда не стоит потому что случится ошибка. Но если Вы пишите программу, в которой работает несколько человек помимо Вас и они понятия не имеют что в ней можно и что нельзя, и они обязательно будут тыкать туда куда нельзя, и эти ошибки Вас просто погубят, потому что все будут грешить на вашу программу.
Конечно же в любой программе необходимо предусмотреть "защиту от дурака", но иногда "дурак" превосходит все ожидания. Если честно, я редко пользуюсь командами для обработки ошибок. Стараюсь предусматривать все возможные варианты действий пользователя, но это иногда заставляет написать такую огромную защиту, что сама программа того не стоит. Вообщем приступим.

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

Sub primer1()

a = 10

b = InputBox("Введите число отличное от 0", "Ввод данных", "0")

c = a / b

MsgBox "Результат: " & a & "/" & b & "=" & c, vbInformation, "Ответ"

End Sub

Способ №1. Перенаправление программы

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

On Error

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

Sub primer1()

On Error GoTo errors

a = 10

b = InputBox("Введите число отличное от 0", "Ввод данных", "0")

c = a / b

MsgBox "Результат: " & a & "/" & b & "=" & c, vbInformation, "Ответ"

GoTo Endprimer

errors:

MsgBox "Ошибка! Вводите корректные данные", vbCritical, "Ошибка"

Endprimer:

End Sub

Поясню. При возникновении ошибки, программа с места ошибки сразу перенаправится на errors: и уже будет продолжать выполнять код с этого места. То-есть с информационного сообщения о том, что у нас возникла ошибка, после этого сообщения программа так и продолжит выполнять макрос дальше, в данном случае программа просто закончится. В случае, если ошибки нет, нам покажется результат и код перенаправится на Endprimer:, так как туда нас перенаправил GoTo.
Если Вы не хотите чтобы макрос выполнялся дальше, то можно добавить команду для выхода из макросаExit Sub (завершение выполнения текущего макроса).

Sub primer1()

On Error GoTo errors

a = 10

b = InputBox("Введите число отличное от 0", "Ввод данных", "0")

c = a / b

MsgBox "Результат: " & a & "/" & b & "=" & c, vbInformation, "Ответ"

GoTo Endprimer

errors:

MsgBox "Ошибка! Вводите кооректные данные", vbCritical, "Ошибка"

Exit Sub

Endprimer:

End Sub

Способ №2. Настойчивость в исправлении ошибки

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

Sub primer2()

On Error GoTo errors

a = 10

b = InputBox("Введите число отличное от 0", "Ввод данных", "0")

c = a / b

MsgBox "Результат: " & a & "/" & b & "=" & c, vbInformation, "Ответ"

GoTo vpered

errors:

MsgBox "Ошибка! Повторите ввод", vbCritical, "Ошибка"

b = InputBox("Введите число отличное от 0", "Ввод данных", "0")

Resume

vpered:

End Sub

Тут у нас добавилась только одна новая команда Resume, которая и будет перенапрявлять программу на место возникновения ошибки, тем самым требовать от нас правильного ввода данных, и пока мы их не введём, программа так и будет требовать от нас непонятного.

Способ №3. Предупреждён. Сообщение об ошибке

Хорошо, что разработчики VBA дали такой большой спектр обработки ошибок. Следующий способ уведомит Вас о произошедшей ошибке и выдаст её номер, а так же спросит Вас нужно ли выполнять программу дальше или всё таки прекратить её выполнение. Выглядеть это будет так.

Sub primer3()

On Error GoTo errors

a = 10

b = InputBox("Введите число отличное от 0", "Ввод данных", "0")

c = a / b

MsgBox "Результат: " & a & "/" & b & "=" & c, vbInformation, "Ответ"

GoTo propusk

errors:

If Err.Number 0 Then

resultat = MsgBox("При выполнении программы произошла ошибка №" & Err.Number & _

vbNewLine & "Продолжить выполнение программы не смотря на ошибку?", _

vbYesNo + vbCritical, "Ошибка")

If resultat = vbYes Then

Resume Next

Else

Exit Sub

End If

End If

propusk:

End Sub

Тут у нас добавилось ещё одна новая команда Resume Next, которая говорит о том, что код необходимо продолжать выполнять дальше с места обнаружения ошибки, не смотря ни на что.

Способ №4. Очистка ошибки

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

Sub primer4()

On Error Resume Next

a = 10

b = InputBox("Введите число отличное от 0", "Ввод данных", "0")

c = a / b

MsgBox "Результат: " & a & "/" & b & "=" & c, vbInformation, "Ответ"

If Err.Number 0 Then

p = Err.Number

Err.Clear

MsgBox "Ошибка " & p & " очищена!", vbInformation, "Уведомление"

End If

End Sub

Способ №5. Идём напролом

Если Вам наплевать на все ошибки и Вы даже не хотите о них слышать, то можно воспользоваться следующей записью.

Sub primer5()

On Error Resume Next

a = 10

b = InputBox("Введите число отличное от 0", "Ввод данных", "0")

c = a / b

MsgBox "Результат: " & a & "/" & b & "=" & c, vbInformation, "Ответ"

End Sub

При такой записи макрос будет продолжать выполняться не смотря на все ошибки.

Я думаю, что на основе этих примеров и уловок остальные способы обработки ошибок Вы сможете придумать сами, придумать такие, на какие Вам хватит фантазии.