When called to explain some usages I say that I really like using the Items() or the Keys() methods, they provide an array of variants ready to be pasted onto a sheet.
The bulk setter method for a Range is Range.Value (or Range.Value2). I had thought that only a variant array works with this. In the experiment below it turns out that one can supply an array of Strings, Dates, Double, Booleans etc.
It turns out the performance between pasting an array and pasting the Items from a Dictionary are very similar. There is one key difference though for Dates, the Dictionary's output will format them as Dates whereas pasting an array of dates gives you doubles. A further experiment where we store dates in an array of Variants fixes the formatting bug (TIP!).
Later in the code are timing procedures, adjusting for a "cold start" it seems we can say that they are similarly fast.
So I guess only use Dictionary if you need the Exists() method because this is a feature that an array does not have. Also from a strong typing point of view the Array does indicate its type (except where you use the tip of storing dates in variant for fixing format bug, see above).
Here is the code and you'll need a class from a Stack Overflow answer. When pasted in run the procedure TestAll() with F5.
Option Explicit
Option Private Module
Private m_wsWork As Excel.Worksheet
Private Property Get mwsWork() As Excel.Worksheet
If m_wsWork Is Nothing Then
Set m_wsWork = Sheet3 '* <----- different for you
End If
Set mwsWork = m_wsWork
End Property
Private Sub TestAll()
mwsWork.Rows("1:20").Delete
'
TestArrayOfStrings
TestDictionaryOfStrings
'
TestArrayOfDates '* formats dates as double, boo!
TestArrayOfDatesInVariants '* formats dates as dates, hooray!
TestDictionaryOfDates '* formats dates as dates
'
'* TIMIMGS
'* warning, it seems the memory allocator needs to "warmed up"
'* because the top of the following list suffers a cold start penalty
'* (perhaps OS context switch is responsible)
Dim l: For l = 1 To 20: TestTimingsOfDoubles False: Next l
Debug.Print vbNewLine & "Timings:{"
TestTimingsOfLongs True
TestTimingsOfBooleans True
TestTimingsOfDates True
TestTimingsOfDatesInVariants True
TestTimingsOfStrings True
TestTimingsOfDoubles True
Debug.Print "}"
End Sub
Private Sub TestArrayOfStrings()
Dim lLoop As Long
Dim arrayOfStrings() As String
For lLoop = 1 To 5
ReDim Preserve arrayOfStrings(1 To lLoop) '* Does this copy the array every time?
arrayOfStrings(lLoop) = Chr$(64 + lLoop)
Next lLoop
mwsWork.Cells(1, 1).Value = "ArrayOfStrings"
mwsWork.Cells(1, 2).Resize(1, 5).Value = arrayOfStrings
End Sub
Private Sub TestDictionaryOfStrings()
Dim lLoop As Long
Dim dicOfStrings As New Scripting.Dictionary
For lLoop = 1 To 5
dicOfStrings.Add dicOfStrings.Count, Chr$(64 + lLoop)
Next lLoop
mwsWork.Cells(3, 1).Value = "DictOfStrings"
mwsWork.Cells(3, 2).Resize(1, 5).Value = dicOfStrings.Items
'mwsWork.Cells(4, 2).Resize(1, 5).Value = dicOfStrings.Keys '* Keys() also exports paste-able array
End Sub
Private Sub TestArrayOfDates()
Dim lLoop As Long
Dim arrayOfDates() As Date
For lLoop = 1 To 5
ReDim Preserve arrayOfDates(1 To lLoop) '* Does this copy the array every time?
arrayOfDates(lLoop) = Now() + lLoop
Next lLoop
mwsWork.Cells(6, 1).Value = "ArrayOfDates"
mwsWork.Cells(6, 2).Resize(1, 5).Value = arrayOfDates '* despite use of Value and not Value2 dates get pasted as doubles
End Sub
Private Sub TestArrayOfDatesInVariants()
Dim lLoop As Long
Dim arrayOfDatesInVariants() As Variant
For lLoop = 1 To 5
ReDim Preserve arrayOfDatesInVariants(1 To lLoop) '* Does this copy the array every time?
arrayOfDatesInVariants(lLoop) = Now() + lLoop
Next lLoop
mwsWork.Cells(7, 1).Value = "ArrayOfDatesInVariants"
mwsWork.Cells(7, 2).Resize(1, 5).Value = arrayOfDatesInVariants '* despite use of Value and not Value2 dates get pasted as doubles
End Sub
Private Sub TestDictionaryOfDates()
'Debug.Assert VarType(Now() + 1) = vbDate '* so we know the Dictionary is storing a date in its variant
Dim lLoop As Long
Dim dicOfDates As New Scripting.Dictionary
For lLoop = 1 To 5
dicOfDates.Add dicOfDates.Count, Now() + lLoop
Next lLoop
mwsWork.Cells(8, 1).Value = "DictOfDates"
mwsWork.Cells(8, 2).Resize(1, 5).Value = dicOfDates.Items '* gets pasted as dates
End Sub
Private Sub TestTimingsOfStrings(Optional bPrintResults As Boolean)
Dim n As Long
Dim oPM As PerformanceMonitor 'http://stackoverflow.com/questions/31383177/vba-queryperformancecounter-not-working#answer-31387007
Set oPM = New PerformanceMonitor
oPM.StartCounter
Dim lLoop As Long
For n = 1 To 1000
Dim dicOfStrings As Scripting.Dictionary
Set dicOfStrings = New Scripting.Dictionary
For lLoop = 1 To 50
dicOfStrings.Add dicOfStrings.Count, Chr$(64 + lLoop)
Next lLoop
Next
Dim vTimings(1 To 2) As Variant
vTimings(1) = oPM.TimeElapsed
Dim arrayOfStrings() As String
Set oPM = New PerformanceMonitor
oPM.StartCounter
For n = 1 To 1000
For lLoop = 1 To 50
ReDim Preserve arrayOfStrings(1 To lLoop) '* Does this copy the array every time?
arrayOfStrings(lLoop) = Chr$(64 + lLoop)
Next lLoop
Next
vTimings(2) = oPM.TimeElapsed
If bPrintResults Then Debug.Print "Strings:{Dict:" & vTimings(1) & ", Array:" & vTimings(2) & "}"
Set oPM = Nothing
End Sub
Private Sub TestTimingsOfDates(Optional bPrintResults As Boolean)
Dim n As Long
Dim oPM As PerformanceMonitor 'http://stackoverflow.com/questions/31383177/vba-queryperformancecounter-not-working#answer-31387007
Set oPM = New PerformanceMonitor
oPM.StartCounter
Dim lLoop As Long
Debug.Assert VarType(Now() + 1) = vbDate '* so we know the Dictionary is storing a date in its variant
For n = 1 To 1000
Dim dicOfDates As Scripting.Dictionary
Set dicOfDates = New Scripting.Dictionary
For lLoop = 1 To 50
dicOfDates.Add dicOfDates.Count, Now() + lLoop
Next lLoop
Next
Dim vTimings(1 To 2) As Variant
vTimings(1) = oPM.TimeElapsed
Dim arrayOfDates() As Date
Set oPM = New PerformanceMonitor
oPM.StartCounter
For n = 1 To 1000
For lLoop = 1 To 50
ReDim Preserve arrayOfDates(1 To lLoop) '* Does this copy the array every time?
arrayOfDates(lLoop) = Now() + lLoop
Next lLoop
Next
vTimings(2) = oPM.TimeElapsed
If bPrintResults Then Debug.Print "Dates:{Dict:" & vTimings(1) & ", Array:" & vTimings(2) & "}"
Set oPM = Nothing
End Sub
Private Sub TestTimingsOfDoubles(Optional bPrintResults As Boolean = False)
Dim n As Long
Dim oPM As PerformanceMonitor 'http://stackoverflow.com/questions/31383177/vba-queryperformancecounter-not-working#answer-31387007
Set oPM = New PerformanceMonitor
oPM.StartCounter
Dim lLoop As Long
For n = 1 To 1000
Dim dicOfDoubles As Scripting.Dictionary
Set dicOfDoubles = New Scripting.Dictionary
For lLoop = 1 To 50
dicOfDoubles.Add dicOfDoubles.Count, 42802.6794444444
Next lLoop
Next
Dim vTimings(1 To 2) As Variant
vTimings(1) = oPM.TimeElapsed
Dim arrayOfDoubles() As Double
Set oPM = New PerformanceMonitor
oPM.StartCounter
For n = 1 To 1000
For lLoop = 1 To 50
ReDim Preserve arrayOfDoubles(1 To lLoop) '* Does this copy the array every time?
arrayOfDoubles(lLoop) = 42802.6794444444
Next lLoop
Next
vTimings(2) = oPM.TimeElapsed
If bPrintResults Then Debug.Print "Doubles:{Dict:" & vTimings(1) & ", Array:" & vTimings(2) & "}"
Set oPM = Nothing
End Sub
Private Sub TestTimingsOfLongs(Optional bPrintResults As Boolean)
Dim n As Long
Dim oPM As PerformanceMonitor 'http://stackoverflow.com/questions/31383177/vba-queryperformancecounter-not-working#answer-31387007
Set oPM = New PerformanceMonitor
oPM.StartCounter
Dim lLoop As Long
For n = 1 To 1000
Dim dicOfLongs As Scripting.Dictionary
Set dicOfLongs = New Scripting.Dictionary
For lLoop = 1 To 50
dicOfLongs.Add dicOfLongs.Count, 130691232#
Next lLoop
Next
Dim vTimings(1 To 2) As Variant
vTimings(1) = oPM.TimeElapsed
Dim arrayOfLongs() As Long
Set oPM = New PerformanceMonitor
oPM.StartCounter
For n = 1 To 1000
For lLoop = 1 To 50
ReDim Preserve arrayOfLongs(1 To lLoop) '* Does this copy the array every time?
arrayOfLongs(lLoop) = 130691232#
Next lLoop
Next
vTimings(2) = oPM.TimeElapsed
If bPrintResults Then Debug.Print "Longs:{Dict:" & vTimings(1) & ", Array:" & vTimings(2) & "}"
Set oPM = Nothing
End Sub
Private Sub TestTimingsOfBooleans(Optional bPrintResults As Boolean)
Dim n As Long
Dim oPM As PerformanceMonitor 'http://stackoverflow.com/questions/31383177/vba-queryperformancecounter-not-working#answer-31387007
Set oPM = New PerformanceMonitor
oPM.StartCounter
Dim lLoop As Long
For n = 1 To 1000
Dim dicOfBooleans As Scripting.Dictionary
Set dicOfBooleans = New Scripting.Dictionary
For lLoop = 1 To 50
dicOfBooleans.Add dicOfBooleans.Count, True
Next lLoop
Next
Dim vTimings(1 To 2) As Variant
vTimings(1) = oPM.TimeElapsed
Dim arrayOfBooleans() As Boolean
Set oPM = New PerformanceMonitor
oPM.StartCounter
For n = 1 To 1000
For lLoop = 1 To 50
ReDim Preserve arrayOfBooleans(1 To lLoop) '* Does this copy the array every time?
arrayOfBooleans(lLoop) = True
Next lLoop
Next
vTimings(2) = oPM.TimeElapsed
If bPrintResults Then Debug.Print "Booleans:{Dict:" & vTimings(1) & ", Array:" & vTimings(2) & "}"
Set oPM = Nothing
End Sub
Private Sub TestTimingsOfDatesInVariants(Optional bPrintResults As Boolean)
Dim n As Long
Dim oPM As PerformanceMonitor 'http://stackoverflow.com/questions/31383177/vba-queryperformancecounter-not-working#answer-31387007
Set oPM = New PerformanceMonitor
oPM.StartCounter
Dim lLoop As Long
Debug.Assert VarType(Now() + 1) = vbDate '* so we know the Dictionary is storing a date in its variant
For n = 1 To 1000
Dim dicOfDates As Scripting.Dictionary
Set dicOfDates = New Scripting.Dictionary
For lLoop = 1 To 50
dicOfDates.Add dicOfDates.Count, Now() + lLoop
Next lLoop
Next
Dim vTimings(1 To 2) As Variant
vTimings(1) = oPM.TimeElapsed
Dim arrayOfDates() As Variant
Set oPM = New PerformanceMonitor
oPM.StartCounter
For n = 1 To 1000
For lLoop = 1 To 50
ReDim Preserve arrayOfDates(1 To lLoop) '* Does this copy the array every time?
arrayOfDates(lLoop) = Now() + lLoop
Next lLoop
Next
vTimings(2) = oPM.TimeElapsed
If bPrintResults Then Debug.Print "DatesInVariants:{Dict:" & vTimings(1) & ", Array:" & vTimings(2) & "}"
Set oPM = Nothing
End Sub
No comments:
Post a Comment