Hallo Leute,
ich erstelle mir momentan eine Klasse mit Funktionalitäten die ich
häufig benötige um mir zeit zu sparen.
Ich habe mir eine Test-Datei erstellt.
Dort stehen Zahlen v. 1-20000 in Zwei Spalten aufgeteilt.
Ich erstelle erst ein Array aus der UsedRange,
dann konvertiere ich dieses in ein 1-Dimensionales Array,
anschließend Sortiere ich die Werte von Groß nach klein.
Dieser Vorgang benötigt zwischen 0,17 Sekunden und 0,14 Sekunden.
Wenn ich aber mein 1-Dimensionales Array verwende um ein dictionary zu erstellen,
dessen Keys gleich meine Array werte sind, dann mein Array Lösche und ein Array aus
meinen Dictionary Keys erstelle und dieses dann soritere, habe ich eine performence
von nur 0,098 Sekunden.
(jede Zahl gibt es nur einmal, es sind also auch wirklich 20000 Keys)
Habt ihr eine Idee woran das liegen kann..., es macht für mich so gar keinen Sinn
Codes:
Spoiler anzeigen
Test Sub
Timer_ Modul
Funktionen aus Klasse
ich erstelle mir momentan eine Klasse mit Funktionalitäten die ich
häufig benötige um mir zeit zu sparen.
Ich habe mir eine Test-Datei erstellt.
Dort stehen Zahlen v. 1-20000 in Zwei Spalten aufgeteilt.
Ich erstelle erst ein Array aus der UsedRange,
dann konvertiere ich dieses in ein 1-Dimensionales Array,
anschließend Sortiere ich die Werte von Groß nach klein.
Dieser Vorgang benötigt zwischen 0,17 Sekunden und 0,14 Sekunden.
Wenn ich aber mein 1-Dimensionales Array verwende um ein dictionary zu erstellen,
dessen Keys gleich meine Array werte sind, dann mein Array Lösche und ein Array aus
meinen Dictionary Keys erstelle und dieses dann soritere, habe ich eine performence
von nur 0,098 Sekunden.
(jede Zahl gibt es nur einmal, es sind also auch wirklich 20000 Keys)
Habt ihr eine Idee woran das liegen kann..., es macht für mich so gar keinen Sinn
Codes:
Test Sub
Visual Basic-Quellcode
- Sub a()
- Dim Agent_ As New VBAgent
- Dim src(), tmp() As Variant
- Dim varItem As Variant
- Dim d As Double
- Dim dict As Object
- d = Timer_.MicroTimer
- src = Agent_.Range_To_Array_Fast(UsedRange)
- tmp = Agent_.Range_2D_To_1D_Array(src, 0)
- Set dict = Agent_.Convert_To_Dictionary(tmp)
- Erase tmp
- tmp = Agent_.Keys_To_Array(dict)
- Agent_.Quicksort_Variant_Array tmp, True, LBound(tmp), UBound(tmp)
- Debug.Print ((Timer_.MicroTimer - d))
- End Sub
Timer_ Modul
Visual Basic-Quellcode
- #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
- #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
- #End If
- Public Function MicroTimer() As Double
- '
- ' returns seconds
- ' uses Windows API calls to the high resolution timer
- '
- Dim cyTicks1 As Currency
- Dim cyTicks2 As Currency
- Static cyFrequency As Currency
- '
- MicroTimer = 0
- '
- ' get frequency
- '
- If cyFrequency = 0 Then getFrequency cyFrequency
- '
- ' get ticks
- '
- getTickCount cyTicks1
- getTickCount cyTicks2
- If cyTicks2 < cyTicks1 Then cyTicks2 = cyTicks1
- '
- ' calc seconds
- '
- If cyFrequency Then MicroTimer = cyTicks2 / cyFrequency
- End Function
Funktionen aus Klasse
Visual Basic-Quellcode
- Public Function Range_To_Array_Fast(ByRef ThisRange As Range) As Variant()
- Range_To_Array_Fast = ThisRange.Value2
- End Function
- Public Function Range_2D_To_1D_Array(ByRef source() As Variant, ByVal direction_ As Long) As Variant()
- Dim i, ii, n, length_ As Long
- Dim tmp() As Variant
- length_ = (UBound(source, 1) * UBound(source, 2)) - 1
- ReDim tmp(length_): n = 0
- If direction_ = 0 Then
- For i = 1 To UBound(source, 1)
- For ii = 1 To UBound(source, 2)
- tmp(n) = source(i, ii): n = n + 1
- Next ii
- Next i
- Else
- For ii = 1 To UBound(source, 2)
- For i = 1 To UBound(source, 1)
- tmp(n) = source(i, ii): n = n + 1
- Next i
- Next ii
- End If
- Range_2D_To_1D_Array = tmp
- End Function
- Public Function Convert_To_Dictionary(ByRef source() As Variant) As Dictionary
- Dim tmp As New Dictionary
- Dim varItem As Variant
- For Each varItem In source
- If Not tmp.Exists(varItem) Then tmp.Add varItem, vbNull
- Next varItem
- Set Convert_To_Dictionary = tmp: Set tmp = Nothing
- End Function
- Public Function Keys_To_Array(ByRef dictionary_ As Dictionary) As Variant()
- Keys_To_Array = dictionary_.keys
- End Function
- Public Function Quicksort_Variant_Array(ByRef source() As Variant, ByVal Descending_ As Variant, _
- Optional ByVal low As Variant, Optional ByVal high As Variant) As Boolean
- If IsEmpty(source) Then Exit Function
- If IsMissing(low) Then low = LBound(source)
- If IsMissing(high) Then high = UBound(source)
- If Descending_ Then QuicksortDescending source, low, high Else: QuicksortAscending source, low, high
- Quicksort_Variant_Array = True
- End Function
- Private Sub QuicksortDescending(ByRef source() As Variant, ByVal low As Long, ByVal high As Long)
- Dim i As Long: i = low
- Dim j As Long: j = high
- Dim tmp As Variant
- Dim ref As Variant: ref = source((low + high) / 2)
- Do
- While (source(i) > ref): i = i + 1: Wend
- While (source(j) < ref): j = j - 1: Wend
- If (i <= j) Then
- tmp = source(i)
- source(i) = source(j)
- source(j) = tmp
- i = i + 1
- j = j - 1
- End If
- Loop Until (i > j)
- If (low < j) Then QuicksortDescending source, low, j
- If (i < high) Then QuicksortDescending source, i, high
- End Sub