excel-vba
Excel-VBA-optimering

Introduktion

Anmärkningar

Inaktiverar uppdatering av kalkylblad

Inaktivering av beräkningen av kalkylbladet kan minska makrotidens driftstid betydligt. Dessutom skulle det vara fördelaktigt att inaktivera händelser, skärmuppdatering och sidbrytningar. Följande Sub kan användas i valfritt makro för detta ändamål.

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

Följ nedanstående pseudokod för optimering:

Sub MyCode()
    
    OptimizeVBA True

    'Your code goes here

    OptimizeVBA False

End Sub

Kontrollera genomförandetid

Olika procedurer kan ge samma resultat, men de skulle använda olika behandlingstid. För att kolla in vilken som är snabbare kan en sådan kod användas:

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

Använda med block

Att använda med block kan påskynda processen att köra ett makro. Istället skriver du ett intervall, diagramnamn, kalkylblad osv. Som du kan använda med-block som nedan;

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

Vilket är snabbare än detta:

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

Anmärkningar:

• När ett With-block har angetts kan objektet inte ändras. Som ett resultat kan du inte använda en enda With-sats för att påverka ett antal olika objekt

• Hoppa inte in eller ut ur med block . Om uttalanden i ett Med-block exekveras, men antingen Med- eller slutmed-uttalandet inte körs, kvarstår en tillfällig variabel som innehåller en referens till objektet i minnet tills du avslutar proceduren

• Slipa inte in med uttalanden, särskilt om det cachade objektet används som en iterator

• Du kan häcka med uttalanden genom att placera ett With-block i ett annat. Eftersom medlemmar av yttre With-block är maskerade inuti With-blocken måste du emellertid tillhandahålla en fullständigt kvalificerad objektreferens i ett inre With-block till varje medlem av ett objekt i ett yttre With-block.

Häckexempel:

Det här exemplet använder With-uttalandet för att köra en serie uttalanden om ett enda objekt.
Objektet och dess egenskaper är generiska namn som endast används för illustrationsändamål.

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

Mer information om MSDN

Rad radering - Prestanda

• Att radera rader går långsamt, speciellt när man går igenom celler och tar bort rader, en efter en

• Ett annat tillvägagångssätt är att använda en AutoFilter för att dölja raderna som ska raderas

• Kopiera det synliga intervallet och klistra in det i ett nytt arbetsblad

• Ta bort det ursprungliga arket helt

• Med denna metod, desto fler rader att radera, desto snabbare kommer den att vara

Exempel:

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

Inaktivera alla Excel-funktioner innan du kör stora makron

Procedurerna nedan kommer att tillfälligt inaktivera alla Excel-funktioner på WorkBook- och WorkSheet-nivå

• FastWB () är en växel som accepterar på eller av flaggor

• FastWS () accepterar ett valfritt WorkSheet-objekt, eller inget

• Om ws-parametern saknas kommer den att slå på och stänga av alla funktioner för alla WorkSheets i samlingen

  • En anpassad typ kan användas för att fånga alla inställningar innan du stänger av dem
  • I slutet av processen kan de initiala inställningarna återställas

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

Återställ alla Excel-inställningar till standard

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

Optimera felsökning med utökad felsökning

Använda radnummer ... och dokumentera dem vid fel ("Vikten av att se Erl")

Att upptäcka vilken linje som orsakar ett fel är en väsentlig del av felsökningen och begränsar sökningen efter orsaken. För att dokumentera identifierade fellinjer med en kort beskrivning genomförs en framgångsrik felspårning, i bästa fall tillsammans med namnen på modulen och proceduren. Exemplet nedan sparar dessa data i en loggfil.

Bakgrund

Felobjektet returnerar felnummer (Err.Number) och felbeskrivning (Err.Description), men svarar inte uttryckligen på frågan var felet ska hittas. Erl- funktionen gör det dock, men under förutsättning att du lägger till * radnummer ) till koden (BTW en av flera andra koncessioner till tidigare grundtider).

Om det inte finns några fellinjer alls returnerar Erl-funktionen 0, om numreringen är ofullständig får du procedurets sista föregående radnummer.

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

" Ytterligare kod för att visa loggfil

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