Suche…


Einführung

Die Excel-VBA-Optimierung bezieht sich auch auf die Kodierung einer besseren Fehlerbehandlung durch Dokumentation und zusätzliche Details. Dies wird hier gezeigt.

Bemerkungen

*) Zeilennummern sind ganze Zahlen, d. H. Ein vorzeichenbehafteter 16-Bit-Datentyp im Bereich von -32.768 bis 32.767, ansonsten erzeugen Sie einen Überlauf. Üblicherweise werden Zeilennummern in Schritten von 10 über einen Teil des Codes oder alle Prozeduren eines Moduls insgesamt eingefügt.

Arbeitsblattaktualisierung deaktivieren

Durch das Deaktivieren der Berechnung des Arbeitsblatts kann die Laufzeit des Makros erheblich verringert werden. Außerdem wäre das Deaktivieren von Ereignissen, Bildschirmaktualisierungen und Seitenumbrüchen von Vorteil. Folgender Sub kann zu diesem Zweck in einem beliebigen Makro verwendet werden.

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

Zur Optimierung folgen Sie dem unten stehenden Pseudo-Code:

Sub MyCode()
    
    OptimizeVBA True

    'Your code goes here

    OptimizeVBA False

End Sub

Ausführungszeit prüfen

Unterschiedliche Prozeduren können dasselbe Ergebnis liefern, sie würden jedoch andere Verarbeitungszeiten verwenden. Um herauszufinden, welcher schneller ist, kann ein Code wie folgt verwendet werden:

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

Verwendung mit Blöcken

Die Verwendung mit Blöcken kann die Ausführung eines Makros beschleunigen. Statt einen Bereich, einen Diagrammnamen, ein Arbeitsblatt usw. zu schreiben, können Sie With-Blocks wie folgt verwenden.

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

Welches ist schneller als das:

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

Anmerkungen:

  • Sobald ein With-Block eingegeben wurde, kann das Objekt nicht geändert werden. Daher können Sie keine einzelne With-Anweisung verwenden, um eine Reihe verschiedener Objekte zu beeinflussen

  • Springen Sie nicht in With-Blöcke . Wenn Anweisungen in einem With-Block ausgeführt werden, die With- oder End With-Anweisung jedoch nicht ausgeführt wird, bleibt eine temporäre Variable, die einen Verweis auf das Objekt enthält, im Speicher, bis Sie die Prozedur beenden

  • Keine Schleife mit With-Anweisungen, insbesondere wenn das zwischengespeicherte Objekt als Iterator verwendet wird

  • Sie können With-Anweisungen verschachteln, indem Sie einen With-Block in einen anderen einfügen. Da jedoch Mitglieder der äußeren With-Blöcke innerhalb der inneren With-Blöcke maskiert werden, müssen Sie jedem Member eines Objekts in einem äußeren With-Block eine vollständig qualifizierte Objektreferenz in einem inneren With-Block bereitstellen.

Verschachtelungsbeispiel:

In diesem Beispiel wird mit der With-Anweisung eine Reihe von Anweisungen für ein einzelnes Objekt ausgeführt.
Das Objekt und seine Eigenschaften sind generische Namen, die nur zu Illustrationszwecken verwendet werden.

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

Weitere Informationen zu MSDN

Zeilenlöschung - Leistung

  • Das Löschen von Zeilen ist langsam, insbesondere wenn Sie die Zellen durchlaufen und nacheinander Zeilen löschen

  • Ein anderer Ansatz ist die Verwendung eines Autofilters zum Ausblenden der zu löschenden Zeilen

  • Kopieren Sie den sichtbaren Bereich und fügen Sie ihn in ein neues Arbeitsblatt ein

  • Entfernen Sie das Ausgangsblatt vollständig

  • Je mehr Zeilen gelöscht werden, desto schneller wird diese Methode

Beispiel:

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

Deaktivieren aller Excel-Funktionen Vor dem Ausführen großer Makros

In den folgenden Abschnitten werden alle Excel-Funktionen auf WorkBook- und WorkSheet-Ebene vorübergehend deaktiviert

  • FastWB () ist ein Umschalter, der On- oder Off-Flags akzeptiert

  • FastWS () akzeptiert ein optionales WorkSheet-Objekt oder keines

  • Wenn der Parameter ws fehlt, werden alle Funktionen für alle Arbeitsblätter in der Auflistung ein- und ausgeschaltet

    • Mit einem benutzerdefinierten Typ können Sie alle Einstellungen erfassen, bevor Sie sie deaktivieren
    • Am Ende des Prozesses können die ursprünglichen Einstellungen wiederhergestellt werden

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

Setzen Sie alle Excel-Einstellungen auf die Standardeinstellungen zurück

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

Optimierung der Fehlersuche durch erweitertes Debugging

Zeilennummern verwenden ... und im Fehlerfall dokumentieren ("Wie wichtig es ist, Erl zu sehen")

Das Erkennen der Zeile, die einen Fehler auslöst, ist ein wesentlicher Bestandteil des Debugging und begrenzt die Suche nach der Ursache. Die Dokumentation der identifizierten Fehlerzeilen mit einer kurzen Beschreibung vervollständigt eine erfolgreiche Fehlerverfolgung, am besten zusammen mit den Namen des Moduls und der Prozedur. Das folgende Beispiel speichert diese Daten in einer Protokolldatei.

Hintergrund

Das Fehlerobjekt gibt Fehlernummer (Err.Number) und Fehlerbeschreibung (Err.Description) zurück, antwortet jedoch nicht explizit auf die Frage, wo der Fehler zu finden ist. Die Erl- Funktion tut dies jedoch, vorausgesetzt, Sie fügen * ( Zeilennummern ) dem Code hinzu (BTW eine von mehreren anderen Zugeständnisse an frühere Basiszeiten).

Wenn keine Fehlerzeilen vorhanden sind, gibt die Erl-Funktion 0 zurück. Wenn die Nummerierung unvollständig ist, wird die letzte vorangehende Zeilennummer der Prozedur angezeigt.

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

' Zusätzlicher Code zum Anzeigen der Protokolldatei

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


Modified text is an extract of the original Stack Overflow Documentation
Lizenziert unter CC BY-SA 3.0
Nicht angeschlossen an Stack Overflow