Een klasse om VBA performance te meten
Inhoud
Inleiding
Als je veel code schrijft in VBA dan gebeurt het vast wel eens dat je
aanloopt tegen performance problemen. Een klant belt op en klaagt dat het
Excel model dat jij hebt gebouwd traag reageert. In dit korte artikel toon
ik wat VBA code die helpt bij het trouble-shooten van trage VBA routines.
Principe
De code di ik zodadelijk laat zien maakt gebruik van een basisprincipe
van de VBA compiler: Variabelen die gedeclareerd zijn op het subroutine
niveau verliezen hun waarde als de routine wordt beëindigd. Als een dergelijke
variabele verwijst naar een instantie van een klasse, dan zal het betekenen
dat die klasse uit het geheugen gehaald wordt en dat daardoor het terminate
event wordt aangeroepen. Het voorgestelde systeem bevat de volgende elementen:
- Een klasse module genaamd clsPerf waarin we bijhouden op welk moment
de klasse in het geheugen geladen werd en welke tevens een array bevat
met de naam van de aanroepende routine de starttijd en de verstreken
tijd
- Een normale module modPerf die routines bevat die de performance
array reset, de performance matrix rapporteert en een paar pulic variabelen
die bijhouden wat er door de klasses is gelogd.
- Een normale module modTimer die enkele API declaraties en een functie
bevate om een hoge resolutie timer te verkrijgen (Met dank aan Charles
Williams)
- Wat code in iedere subroutine die je wilt timen.
Ik heb dat deel erg simpel gehouden. Omdat ik van plan ben de data in
een werkblad te dumpen en omdat dat heel snel gaat met een array gebruik
ik een array variabele om deze gegevens tijdens het gebruik van de klasse
te bewaren. De module bevat daarom een publieke array variabele en nog een
paar andere hulp variabelen:
'For clsPerf Class:
Public Const gbDebug As
Boolean = True
Public glPerfIndex As
Long
Public gvPerfResults()
As Variant
Public glDepth As
Long
Ik gebruik glPerfIndex om het aantal elementen in de variant array bij
te houden en ik gebruik glDepth om later de routine namen in te kunnen laten
springen conform hun plaats in de "call stack". gbDebug is een constante
die je op false kunt zetten om de performance klasse niet langer te gebruiken.
De clsPerf klasse
De clsPerf klasse is eigenlijk heel eenvoudig:
Option Explicit
'Welk element van gvPerfResults "hoort" bij deze instantie?
Dim mlIndex As
Long
'Wanneer zijn we gestart
Dim mdStartTime As
Double
Private Sub Class_Initialize()
'Een nieuw element om te gaan bijhouden,
verhoog het index getal
glPerfIndex = glPerfIndex + 1
'Houdt bij bij welke index deze klasse
hoort
mlIndex = glPerfIndex
'Verhoog de diepte zodat we een illusie
van een call stack creeeren
glDepth = glDepth + 1
If IsBounded(gvPerfResults)
Then
ReDim
Preserve gvPerfResults(1
To 3, 1 To glPerfIndex)
Else
ReDim
gvPerfResults(1 To 3, 1
To glPerfIndex)
End If
'Wat is de starttijd van deze instantie
mdStartTime = dMicroTimer
End Sub
Public Sub SetRoutine(sRoutineName)
gvPerfResults(1, mlIndex) = String(glDepth
* 4, " ") & sRoutineName
End Sub
Private Sub Class_Terminate()
'Automatisch aangeroepen zodra de variabele
die naar deze instantie verwijst
'out of scope gaat
'Verklein de call stack diepte weer
glDepth = glDepth - 1
'Schrijf de start- en eindtijd weg
gvPerfResults(2, mlIndex) = mdStartTime
gvPerfResults(3, mlIndex) = dMicroTimer - mdStartTime
End Sub
Private Function
IsBounded(vArray As Variant)
As Boolean
Dim lTest As
Long
On Error
Resume Next
lTest = UBound(vArray)
IsBounded = (Err.Number = 0)
End Function
De modPerf module
Er is wat code nodig in een normale module die de array met meetresultaten
vasthoudt. Tevens bevat deze module een routine voor de rapportage van de
resultaten:
Option Explicit
'Tbv de clsPerf klasse:
Public Const gbDebug As
Boolean = True
Public glPerfIndex As
Long
Public gvPerfResults()
As Variant
Public glDepth As
Long
Sub Demo()
Dim cPerf As
clsPerf
ResetPerformance
If gbDebug
Then
Set cPerf
= New clsPerf
cPerf.SetRoutine "Demo"
End If
Application.OnTime Now, "ReportPerformance"
End Sub
Public Sub ResetPerformance()
glPerfIndex = 0
ReDim gvPerfResults(1
To 3, 1 To 1)
End Sub
Public Sub ReportPerformance()
Dim vNewPerf()
As Variant
Dim lRow As
Long
Dim lCol As
Long
ReDim vNewPerf(1
To UBound(gvPerfResults,
2) + 1, 1 To 3)
vNewPerf(1, 1) = "Routine"
vNewPerf(1, 2) = "Started at"
vNewPerf(1, 3) = "Time taken"
For lRow = 1
To UBound(gvPerfResults,
2)
For lCol
= 1 To 3
vNewPerf(lRow
+ 1, lCol) = gvPerfResults(lCol, lRow)
Next
Next
Workbooks.Add
With ActiveSheet
.Range("A1").Resize(UBound(vNewPerf,
1), 3).Value = vNewPerf
.UsedRange.EntireColumn.AutoFit
End With
AddPivot
End Sub
Sub AddPivot()
Dim oSh As
Worksheet
Set oSh = ActiveSheet
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase,
SourceData:= _
oSh.UsedRange.Address(external:=True),
Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:="",
TableName:="PerfReport", DefaultVersion:= _
xlPivotTableVersion14
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3,
1)
ActiveSheet.Cells(3, 1).Select
With ActiveSheet.PivotTables(1)
With .PivotFields("Routine")
.Orientation
= xlRowField
.Position
= 1
End
With
.AddDataField ActiveSheet.PivotTables(1).PivotFields("Time
taken"), "Total Time taken", xlAverage
.PivotFields("Routine").AutoSort
xlDescending, "Total Time taken"
.AddDataField .PivotFields("Time
taken"), "Times called", xlCount
.RowAxisLayout xlTabularRow
.ColumnGrand =
False
.RowGrand = False
End With
End Sub
In principe is alles wat je uit deze module hoeft te doen het uitvoeren
van de routine "ReportPerformance" nadat je jouw code hebt uit laten voeren.
De modTimer module
Deze module bevat enkele Windows API declaraties en een enkele subroutine
die een timestamp ophaalt:
Option Explicit
Option Private
Module
#If VBA7 Then
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
Private Declare
PtrSafe Function timeGetTime
Lib "winmm.dll" () As
Long
#Else
Private Declare
Function getFrequency Lib
"kernel32" Alias "QueryPerformanceFrequency" (cyFrequency
As Currency)
As Long
Private Declare
Function getTickCount Lib
"kernel32" Alias "QueryPerformanceCounter" (cyTickCount
As Currency)
As Long
Private Declare
Function timeGetTime Lib
"winmm.dll" () As Long
#End If
Private mdTime As
Double
Private msComment As
String
Public Function
dMicroTimer() As Double
'-------------------------------------------------------------------------
' Procedure : dMicroTimer
' Author : Charles Williams
www.decisionmodels.com
' Created : 15-June 2007
' Purpose : High resolution timer
'
Used for speed optimisation
'-------------------------------------------------------------------------
Dim cyTicks1
As Currency
Dim cyTicks2
As Currency
Static cyFrequency
As Currency
dMicroTimer = 0
If cyFrequency = 0
Then getFrequency cyFrequency
getTickCount cyTicks1
getTickCount cyTicks2
If cyTicks2 < cyTicks1
Then cyTicks2 = cyTicks1
If cyFrequency
Then dMicroTimer = cyTicks2 / cyFrequency
End Function
De clsPerf
klasse in jouw subroutines implementeren
Start routines
In al je startroutines (routines die jij beschouwd als het beginpunt
van kernfunctionaliteit van je VBA project)zal je de performance timer willen
resetten. Dit doe je door de routine "ResetPerformance" aan te roepen die
hierboven is getoond. Tevens voeg je toe wat onder "Alle andere routines"
staat.
Alle andere routines
Aan alle routines waar je de performance wilt weten voeg je het volgende
toe:
- Een variable declaratie die naar de instantie van de clsPerf klasse
gaat verwijzen
- Een If Then structuur die test op de waarde van de constante gbDebug
en die bij "True" de instantie van de clsPerf klasse laadt en de routine
naam eraan doorgeeft. De cPerf variable cal automatisch worden gereset
zodra de subroutine eindigt waarna het Terminate event van de klasse
ervoor zorgt dat de tijd wordt vastgelegd..
Sub Demo()
Dim cPerf As
clsPerf
If gbDebug
Then
Set cPerf
= New clsPerf
cPerf.SetRoutine "Demo"
End If
'Jouw code komt hier
End Sub
Dat is alles!
Zorg ervoor dat je clsPerf instantieert nadat je eventuele
informatie van de gebruiker hebt opgevraagd, anders meet je de responstijd
van de gebruiker. Dus zorg dat constructies als GetOpenFileName of MsgBox
of Userforms, komen voor dat instantieren.
De resultaten rapporteren
Zodar je laatste routine geeindigd is kan je eenvoudig de routine "ReportPerformance"
in modPerf aanroepen om een draaitabel met de meetresultaten te laten maken.
Demo bestand
Download het demo bestand
Conclusie
Ik hoop dat ik een beetje hulp heb kunnen bieden door het torubleshooten
van de performance van je VBA project te vergemakkelijken. Laat maar weten
wat je ervaringen hiermee zijn!