excel-vba
Optymalizacja Excel-VBA

Wprowadzenie

Uwagi

Wyłączanie aktualizacji arkusza roboczego

Wyłączenie obliczania arkusza roboczego może znacznie skrócić czas działania makra. Ponadto korzystne byłoby wyłączenie zdarzeń, aktualizacji ekranu i podziałów stron. W następstwie Sub może być stosowany w każdym makro do tego celu.

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

W celu optymalizacji postępuj zgodnie z poniższym pseudokodem:

Sub MyCode()
    
    OptimizeVBA True

    'Your code goes here

    OptimizeVBA False

End Sub

Sprawdzanie czasu wykonania

Różne procedury mogą dać ten sam wynik, ale wykorzystałyby inny czas przetwarzania. Aby sprawdzić, który jest szybszy, można użyć takiego kodu:

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

Korzystanie z bloków

Używanie z blokami może przyspieszyć proces uruchamiania makra. Zamiast pisać zakres, nazwę wykresu, arkusz roboczy itp., Możesz użyć bloków takich jak poniżej;

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

Który jest szybszy niż to:

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

Uwagi:

• Po wprowadzeniu bloku With nie można zmienić obiektu. W rezultacie nie można użyć pojedynczej instrukcji With, aby wpłynąć na wiele różnych obiektów

• Nie wskakuj do ani z bloków . Jeśli wykonywane są instrukcje w bloku With, ale nie jest wykonywana ani instrukcja With, ani End With, zmienna tymczasowa zawierająca odwołanie do obiektu pozostaje w pamięci do momentu zakończenia procedury

• Nie zapętlaj instrukcji wewnątrz, szczególnie jeśli buforowany obiekt jest używany jako iterator

• Można zagnieżdżać instrukcje With, umieszczając jeden blok With w innym. Ponieważ jednak elementy zewnętrznych bloków With są maskowane w wewnętrznych blokach With, należy podać w pełni kwalifikowane odwołanie do obiektu w wewnętrznym bloku With do dowolnego elementu obiektu w zewnętrznym bloku With.

Przykład zagnieżdżenia:

W tym przykładzie użyto instrukcji With do wykonania serii instrukcji na jednym obiekcie.
Obiekt i jego właściwości są ogólnymi nazwami używanymi wyłącznie do celów ilustracyjnych.

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

Więcej informacji o MSDN

Usuwanie wiersza - wydajność

• Usuwanie wierszy jest powolne, szczególnie podczas zapętlania komórek i usuwania wierszy, jeden po drugim

• Inne podejście polega na użyciu filtru automatycznego do ukrycia wierszy, które mają zostać usunięte

• Skopiuj widoczny zakres i wklej go do nowego arkusza roboczego

• Usuń całkowicie arkusz początkowy

• Dzięki tej metodzie im więcej wierszy do usunięcia, tym szybciej

Przykład:

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

Wyłączanie wszystkich funkcji programu Excel przed uruchomieniem dużych makr

Poniższe procedury tymczasowo wyłączą wszystkie funkcje programu Excel na poziomie WorkBook i WorkSheet

• FastWB () to przełącznik, który akceptuje flagi On lub Off

• FastWS () akceptuje opcjonalny obiekt WorkSheet lub żaden

• Jeśli brakuje parametru ws, włącza i wyłącza wszystkie funkcje dla wszystkich arkuszy roboczych w kolekcji

  • Typu niestandardowego można użyć do przechwycenia wszystkich ustawień przed ich wyłączeniem
  • Pod koniec procesu można przywrócić ustawienia początkowe

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

Przywróć wszystkie ustawienia programu Excel do domyślnych

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

Optymalizacja wyszukiwania błędów przez rozszerzone debugowanie

Używanie numerów linii ... i dokumentowanie ich w przypadku błędu („Znaczenie widzenia Erl”)

Wykrywanie, która linia powoduje błąd, stanowi istotną część debugowania i zawęża wyszukiwanie przyczyny. Aby udokumentować zidentyfikowane linie błędów za pomocą krótkiego opisu, należy zakończyć pomyślne śledzenie błędów, w najlepszym razie wraz z nazwami modułów i procedur. Poniższy przykład zapisuje te dane w pliku dziennika.

Tło

Obiekt błędu zwraca numer błędu (Err.Number) i opis błędu (Err.Description), ale nie odpowiada wprost na pytanie, gdzie zlokalizować błąd. Jednak funkcja Erl tak robi, ale pod warunkiem, że dodasz * numery linii ) do kodu (BTW to jedna z kilku innych ustępstw do dawnych czasów podstawowych).

Jeśli w ogóle nie ma linii błędów, funkcja Erl zwraca 0, jeśli numeracja jest niekompletna, otrzymasz ostatni poprzedni numer procedury.

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

„ Dodatkowy kod do wyświetlenia pliku dziennika

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