Merkwürdige Performance verbesserung

  • Excel

Es gibt 2 Antworten in diesem Thema. Der letzte Beitrag () ist von Petersilie.

    Merkwürdige Performance verbesserung

    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

    Visual Basic-Quellcode

    1. Sub a()
    2. Dim Agent_ As New VBAgent
    3. Dim src(), tmp() As Variant
    4. Dim varItem As Variant
    5. Dim d As Double
    6. Dim dict As Object
    7. d = Timer_.MicroTimer
    8. src = Agent_.Range_To_Array_Fast(UsedRange)
    9. tmp = Agent_.Range_2D_To_1D_Array(src, 0)
    10. Set dict = Agent_.Convert_To_Dictionary(tmp)
    11. Erase tmp
    12. tmp = Agent_.Keys_To_Array(dict)
    13. Agent_.Quicksort_Variant_Array tmp, True, LBound(tmp), UBound(tmp)
    14. Debug.Print ((Timer_.MicroTimer - d))
    15. End Sub



    Timer_ Modul

    Visual Basic-Quellcode

    1. #If VBA7 Then
    2. Private Declare PtrSafe Function getFrequency Lib "kernel32" Alias _
    3. "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
    4. Private Declare PtrSafe Function getTickCount Lib "kernel32" Alias _
    5. "QueryPerformanceCounter" (cyTickCount As Currency) As Long
    6. #Else
    7. Private Declare Function getFrequency Lib "kernel32" Alias _
    8. "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
    9. Private Declare Function getTickCount Lib "kernel32" Alias _
    10. "QueryPerformanceCounter" (cyTickCount As Currency) As Long
    11. #End If
    12. Public Function MicroTimer() As Double
    13. '
    14. ' returns seconds
    15. ' uses Windows API calls to the high resolution timer
    16. '
    17. Dim cyTicks1 As Currency
    18. Dim cyTicks2 As Currency
    19. Static cyFrequency As Currency
    20. '
    21. MicroTimer = 0
    22. '
    23. ' get frequency
    24. '
    25. If cyFrequency = 0 Then getFrequency cyFrequency
    26. '
    27. ' get ticks
    28. '
    29. getTickCount cyTicks1
    30. getTickCount cyTicks2
    31. If cyTicks2 < cyTicks1 Then cyTicks2 = cyTicks1
    32. '
    33. ' calc seconds
    34. '
    35. If cyFrequency Then MicroTimer = cyTicks2 / cyFrequency
    36. End Function




    Funktionen aus Klasse

    Visual Basic-Quellcode

    1. Public Function Range_To_Array_Fast(ByRef ThisRange As Range) As Variant()
    2. Range_To_Array_Fast = ThisRange.Value2
    3. End Function
    4. Public Function Range_2D_To_1D_Array(ByRef source() As Variant, ByVal direction_ As Long) As Variant()
    5. Dim i, ii, n, length_ As Long
    6. Dim tmp() As Variant
    7. length_ = (UBound(source, 1) * UBound(source, 2)) - 1
    8. ReDim tmp(length_): n = 0
    9. If direction_ = 0 Then
    10. For i = 1 To UBound(source, 1)
    11. For ii = 1 To UBound(source, 2)
    12. tmp(n) = source(i, ii): n = n + 1
    13. Next ii
    14. Next i
    15. Else
    16. For ii = 1 To UBound(source, 2)
    17. For i = 1 To UBound(source, 1)
    18. tmp(n) = source(i, ii): n = n + 1
    19. Next i
    20. Next ii
    21. End If
    22. Range_2D_To_1D_Array = tmp
    23. End Function
    24. Public Function Convert_To_Dictionary(ByRef source() As Variant) As Dictionary
    25. Dim tmp As New Dictionary
    26. Dim varItem As Variant
    27. For Each varItem In source
    28. If Not tmp.Exists(varItem) Then tmp.Add varItem, vbNull
    29. Next varItem
    30. Set Convert_To_Dictionary = tmp: Set tmp = Nothing
    31. End Function
    32. Public Function Keys_To_Array(ByRef dictionary_ As Dictionary) As Variant()
    33. Keys_To_Array = dictionary_.keys
    34. End Function
    35. Public Function Quicksort_Variant_Array(ByRef source() As Variant, ByVal Descending_ As Variant, _
    36. Optional ByVal low As Variant, Optional ByVal high As Variant) As Boolean
    37. If IsEmpty(source) Then Exit Function
    38. If IsMissing(low) Then low = LBound(source)
    39. If IsMissing(high) Then high = UBound(source)
    40. If Descending_ Then QuicksortDescending source, low, high Else: QuicksortAscending source, low, high
    41. Quicksort_Variant_Array = True
    42. End Function
    43. Private Sub QuicksortDescending(ByRef source() As Variant, ByVal low As Long, ByVal high As Long)
    44. Dim i As Long: i = low
    45. Dim j As Long: j = high
    46. Dim tmp As Variant
    47. Dim ref As Variant: ref = source((low + high) / 2)
    48. Do
    49. While (source(i) > ref): i = i + 1: Wend
    50. While (source(j) < ref): j = j - 1: Wend
    51. If (i <= j) Then
    52. tmp = source(i)
    53. source(i) = source(j)
    54. source(j) = tmp
    55. i = i + 1
    56. j = j - 1
    57. End If
    58. Loop Until (i > j)
    59. If (low < j) Then QuicksortDescending source, low, j
    60. If (i < high) Then QuicksortDescending source, i, high
    61. End Sub

    Und wenn du die Reihenfolge drehst, ist dein Sortieren der Dictionary Keys langsamer?

    Falls nicht, liegt es vielleicht daran, dass das Dictionary bei den Keys erkennt, dass alles Zahlen sind und anstatt Variant Long verwendet.
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „petaod“ ()