excel-vba
Excel-VBA-optimalisatie
Zoeken…
Invoering
Excel-VBA-optimalisatie verwijst ook naar codering van betere foutafhandeling door documentatie en aanvullende details. Dit wordt hier getoond.
Opmerkingen
*) Regelnummers vertegenwoordigen gehele getallen, dat wil zeggen een 16-bits gegevenstype in het bereik van -32.768 tot 32.767, anders produceert u een overloop. Gewoonlijk worden regelnummers ingevoegd in stappen van 10 over een deel van de code of alle procedures van een module als geheel.
Werkblad bijwerken uitschakelen
Het uitschakelen van de berekening van het werkblad kan de looptijd van de macro aanzienlijk verkorten. Bovendien zou het uitschakelen van evenementen, schermupdates en pagina-einden voordelig zijn. De volgende Sub
kan voor dit doel in elke macro worden gebruikt.
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
Voor optimalisatie volg de onderstaande pseudo-code:
Sub MyCode()
OptimizeVBA True
'Your code goes here
OptimizeVBA False
End Sub
Tijdstip van uitvoering controleren
Verschillende procedures kunnen hetzelfde resultaat geven, maar ze zouden een verschillende verwerkingstijd gebruiken. Om te controleren welke sneller is, kan een dergelijke code worden gebruikt:
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)
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
Gebruiken met blokken
Gebruik met blokken kan het uitvoeren van een macro versnellen. In plaats daarvan kunt u een bereik, grafieknaam, werkblad, enz. Schrijven die u kunt gebruiken met blokken zoals hieronder;
With ActiveChart
.Parent.Width = 400
.Parent.Height = 145
.Parent.Top = 77.5 + 165 * step - replacer * 15
.Parent.Left = 5
End With
Wat sneller is dan dit:
ActiveChart.Parent.Width = 400
ActiveChart.Parent.Height = 145
ActiveChart.Parent.Top = 77.5 + 165 * step - replacer * 15
ActiveChart.Parent.Left = 5
Opmerkingen:
Nadat een blok With is ingevoerd, kan het object niet meer worden gewijzigd. Als gevolg hiervan kunt u geen enkele With-instructie gebruiken om een aantal verschillende objecten te beïnvloeden
Spring niet in of uit met blokken . Als instructies in een blok With worden uitgevoerd, maar de instructie With of End With niet wordt uitgevoerd, blijft een tijdelijke variabele met een verwijzing naar het object in het geheugen totdat u de procedure verlaat
Loop niet binnen met instructies, vooral als het in de cache opgeslagen object wordt gebruikt als iterator
Je kunt With-instructies nesten door het ene With-blok in het andere te plaatsen. Omdat leden van buitenste With-blokken echter worden gemaskeerd binnen de binnenste With-blokken, moet u een volledig gekwalificeerde objectreferentie in een binnenste With-blok verstrekken aan elk lid van een object in een buitenste With-blok.
Voorbeeld van nesten:
In dit voorbeeld wordt de instructie With gebruikt om een reeks instructies op een enkel object uit te voeren.
Het object en zijn eigenschappen zijn generieke namen die alleen ter illustratie worden gebruikt.
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
Meer informatie over MSDN
Rij verwijderen - Prestaties
Het verwijderen van rijen gaat langzaam, vooral wanneer u cellen doorloopt en rijen een voor een verwijdert
Een andere benadering is het gebruik van een AutoFilter om de te verwijderen rijen te verbergen
Kopieer het zichtbare bereik en plak het in een nieuw werkblad
Verwijder het eerste vel volledig
Met deze methode geldt: hoe meer rijen u verwijdert, des te sneller
Voorbeeld:
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
Alle Excel-functionaliteit uitschakelen Voordat u grote macro's uitvoert
Met de onderstaande procedures worden alle Excel-functies op WorkBook- en WorkSheet-niveau tijdelijk uitgeschakeld
FastWB () is een schakelaar die vlaggen Aan of Uit accepteert
FastWS () accepteert een optioneel WorkSheet-object of geen
Als de parameter ws ontbreekt, worden alle functies voor alle werkbladen in de verzameling in- en uitgeschakeld
- Een aangepast type kan worden gebruikt om alle instellingen vast te leggen voordat ze worden uitgeschakeld
- Aan het einde van het proces kunnen de oorspronkelijke instellingen worden hersteld
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
Herstel alle Excel-instellingen naar standaard
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
Optimaliseren van foutzoeken door uitgebreid debuggen
Regelnummers gebruiken ... en deze documenteren in geval van fouten ("Het belang van het zien van Erl")
Het detecteren van welke regel een fout veroorzaakt, is een substantieel onderdeel van foutopsporing en beperkt de zoekopdracht naar de oorzaak. Het identificeren van geïdentificeerde foutregels met een korte beschrijving voltooit een succesvolle foutopsporing, op zijn best samen met de namen van module en procedure. In het onderstaande voorbeeld worden deze gegevens opgeslagen in een logbestand.
Achtergrond
Het foutobject retourneert foutnummer (Err.Number) en foutbeschrijving (Err.Description), maar reageert niet expliciet op de vraag waar de fout moet worden gevonden. De Erl functie echter wel, maar op voorwaarde dat u * lijn nummers toe te voegen) om de code (Trouwens een van de vele andere concessies aan de voormalige Basic keer).
Als er helemaal geen foutregels zijn, retourneert de Erl-functie 0, als de nummering onvolledig is, krijgt u het laatste regelnummer van de procedure.
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
' Extra code om logbestand te tonen
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