excel-vba
Оптимизация Excel-VBA

Вступление

замечания

Отключение обновления рабочего листа

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

Sub OptimizeVBA(isOn As Boolean)
    Application.Calculation = IIf(isOn, xlCalculationManual, xlCalculationAutomatic)
    Application.EnableEvents = Not(isOn)
    Application.ScreenUpdating = Not(isOn)
    ActiveSheet.DisplayPageBreaks = Not(isOn)
End Sub

Для оптимизации следуйте приведенному ниже псевдокоду:

Sub MyCode()
    
    OptimizeVBA True

    'Your code goes here

    OptimizeVBA False

End Sub

Проверка времени выполнения

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

time1 = Timer

For Each iCell In MyRange
   iCell = "text"
Next iCell

time2 = Timer

For i = 1 To 30
   MyRange.Cells(i) = "text"
Next i

time3 = Timer

debug.print "Proc1 time: " & cStr(time2-time1)
debug.print "Proc2 time: " & cStr(time3-time2)

MicroTimer :

Private Declare PtrSafe Function getFrequency Lib "Kernel32" Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
Private Declare PtrSafe Function getTickCount Lib "Kernel32" Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long

Function MicroTimer() As Double
    Dim cyTicks1 As Currency
    Static cyFrequency As Currency

    MicroTimer = 0
    If cyFrequency = 0 Then getFrequency cyFrequency        'Get frequency
    getTickCount cyTicks1                                   'Get ticks
    If cyFrequency Then MicroTimer = cyTicks1 / cyFrequency 'Returns Seconds
End Function

Использование с блоками

Использование с блоками может ускорить процесс запуска макроса. Вместо написания диапазона, имени диаграммы, рабочего листа и т. Д. Вы можете использовать с-блоками, как показано ниже;

With ActiveChart
    .Parent.Width = 400
    .Parent.Height = 145
    .Parent.Top = 77.5 + 165 * step - replacer * 15
    .Parent.Left = 5
End With 

Это быстрее, чем это:

ActiveChart.Parent.Width = 400
ActiveChart.Parent.Height = 145
ActiveChart.Parent.Top = 77.5 + 165 * step - replacer * 15
ActiveChart.Parent.Left = 5

Заметки:

• После ввода блока «С» объект нельзя изменить. В результате вы не можете использовать один оператор WITH для воздействия на несколько разных объектов

• Не прыгайте в или из С блоками . Если выполняются операторы в блоке С, но оператор WITH или End With не выполняется, временная переменная, содержащая ссылку на объект, остается в памяти до тех пор, пока вы не выйдете из процедуры

• Не замыкайтесь внутри. С операторами, особенно если кешированный объект используется как итератор

• Вы можете вставлять с утверждениями, помещая один с блоком в другой. Однако, поскольку элементы внешних блоков Block замаскированы внутри внутреннего блока С, вы должны предоставить полностью квалифицированную ссылку на объект во внутреннем блоке с любым элементом объекта во внешнем блоке С.

Пример гнездования:

В этом примере используется оператор WITH для выполнения ряда операторов для одного объекта.
Объект и его свойства - это общие имена, используемые только для иллюстрации.

With MyObject 
    .Height = 100               'Same as MyObject.Height = 100. 
    .Caption = "Hello World"    'Same as MyObject.Caption = "Hello World". 
    With .Font 
        .Color = Red            'Same as MyObject.Font.Color = Red. 
        .Bold = True            'Same as MyObject.Font.Bold = True. 
        MyObject.Height = 200   'Inner-most With refers to MyObject.Font (must be qualified
    End With
End With

Дополнительная информация о MSDN

Удаление строк - производительность

• Удаление строк происходит медленно, особенно при переходе по ячейкам и удалении строк один за другим

• Другой подход - использовать AutoFilter, чтобы скрыть удаляемые строки

• Скопируйте видимый диапазон и вставьте его в новый рабочий лист

• Удалите исходный лист целиком

• С помощью этого метода, чем больше строк будет удалено, тем быстрее будет

Пример:

Option Explicit

'Deleted rows: 775,153, Total Rows: 1,000,009, Duration: 1.87 sec

Public Sub DeleteRows()
    Dim oldWs As Worksheet, newWs As Worksheet, wsName As String, ur As Range

    Set oldWs = ThisWorkbook.ActiveSheet
    wsName = oldWs.Name
    Set ur = oldWs.Range("F2", oldWs.Cells(oldWs.Rows.Count, "F").End(xlUp))

    Application.ScreenUpdating = False
    Set newWs = Sheets.Add(After:=oldWs)    'Create a new WorkSheet

    With ur    'Copy visible range after Autofilter (modify Criteria1 and 2 accordingly)
        .AutoFilter Field:=1, Criteria1:="<>0", Operator:=xlAnd, Criteria2:="<>"
        oldWs.UsedRange.Copy
    End With
    'Paste all visible data into the new WorkSheet (values and formats)
    With newWs.Range(oldWs.UsedRange.Cells(1).Address)
        .PasteSpecial xlPasteColumnWidths
        .PasteSpecial xlPasteAll
        newWs.Cells(1, 1).Select: newWs.Cells(1, 1).Copy
    End With

    With Application
        .CutCopyMode = False
        .DisplayAlerts = False
            oldWs.Delete
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    newWs.Name = wsName
End Sub

Отключение всех функций Excel Перед выполнением больших макросов

Нижеприведенные процедуры временно отключат все функции Excel на уровне WorkBook и WorkSheet

• FastWB () - это переключатель, который принимает флаги Вкл. Или Выкл.

• FastWS () принимает необязательный объект WorkSheet или нет

• Если параметр ws отсутствует, он включит и выключит все функции для всех рабочих таблиц в коллекции

  • Пользовательский тип может использоваться для захвата всех параметров перед их отключением
  • В конце процесса начальные настройки могут быть восстановлены

Public Sub FastWB(Optional ByVal opt As Boolean = True)
    With Application
        .Calculation = IIf(opt, xlCalculationManual, xlCalculationAutomatic)
        If .DisplayAlerts <> Not opt Then .DisplayAlerts = Not opt
        If .DisplayStatusBar <> Not opt Then .DisplayStatusBar = Not opt
        If .EnableAnimations <> Not opt Then .EnableAnimations = Not opt
        If .EnableEvents <> Not opt Then .EnableEvents = Not opt
        If .ScreenUpdating <> Not opt Then .ScreenUpdating = Not opt
    End With
    FastWS , opt
End Sub

Public Sub FastWS(Optional ByVal ws As Worksheet, Optional ByVal opt As Boolean = True)
    If ws Is Nothing Then
        For Each ws In Application.ThisWorkbook.Sheets
            OptimiseWS ws, opt
        Next
    Else
        OptimiseWS ws, opt
    End If
End Sub
Private Sub OptimiseWS(ByVal ws As Worksheet, ByVal opt As Boolean)
    With ws
        .DisplayPageBreaks = False
        .EnableCalculation = Not opt
        .EnableFormatConditionsCalculation = Not opt
        .EnablePivotTable = Not opt
    End With
End Sub

Восстановить все настройки Excel по умолчанию.

Public Sub XlResetSettings()    'default Excel settings
    With Application
        .Calculation = xlCalculationAutomatic
        .DisplayAlerts = True
        .DisplayStatusBar = True
        .EnableAnimations = False
        .EnableEvents = True
        .ScreenUpdating = True
        Dim sh As Worksheet
        For Each sh In Application.ThisWorkbook.Sheets
            With sh
                .DisplayPageBreaks = False
                .EnableCalculation = True
                .EnableFormatConditionsCalculation = True
                .EnablePivotTable = True
            End With
        Next
    End With
End Sub

Оптимизация поиска ошибок с помощью расширенной отладки

Использование номеров строк ... и документирование их в случае ошибки («важность просмотра Erl»)

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

Фон

Объект ошибки возвращает номер ошибки (Err.Number) и описание ошибки (Err.Description), но явно не отвечает на вопрос, где найти ошибку. Однако функция Erl делает, но при условии, что вы добавляете * номера строк ) к коду (BTW одна из нескольких других уступок бывшим основным временам).

Если линий ошибок вообще нет, то функция Erl возвращает 0, если нумерация неполна, вы получите последний номер строки предыдущей строки.

Option Explicit


Public Sub MyProc1()
Dim i As Integer
Dim j As Integer
On Error GoTo LogErr
10     j = 1 / 0    ' raises an error
okay:
Debug.Print "i=" & i
Exit Sub

LogErr:
MsgBox LogErrors("MyModule", "MyProc1", Err), vbExclamation, "Error " & Err.Number
Stop
Resume Next
End Sub

Public Function LogErrors( _
           ByVal sModule As String, _
           ByVal sProc As String, _
           Err As ErrObject) As String
' Purpose: write error number, description and Erl to log file and return error text
  Dim sLogFile As String: sLogFile = ThisWorkbook.Path & Application.PathSeparator & "LogErrors.txt"
  Dim sLogTxt  As String
  Dim lFile    As Long

' Create error text
  sLogTxt = sModule & "|" & sProc & "|Erl " & Erl & "|Err " & Err.Number & "|" & Err.Description

  On Error Resume Next
  lFile = FreeFile

  Open sLogFile For Append As lFile
  Print #lFile, Format$(Now(), "yy.mm.dd hh:mm:ss "); sLogTxt
      Print #lFile,
  Close lFile
' Return error text
  LogErrors = sLogTxt
 End Function

' Дополнительный код для отображения файла журнала

Sub ShowLogFile()
Dim sLogFile As String: sLogFile = ThisWorkbook.Path & Application.PathSeparator & "LogErrors.txt"

On Error GoTo LogErr
Shell "notepad.exe " & sLogFile, vbNormalFocus

okay:
On Error Resume Next
Exit Sub

LogErr:
MsgBox LogErrors("MyModule", "ShowLogFile", Err), vbExclamation, "Error No " & Err.Number
Resume okay
End Sub