Code geschwindkeit, zu langsam oder in Ordnung?
08.09.2017 13:05:05
Peter(silie)
ich habe eine Eingabemaske erstellt, für ein Workbook
welches als "Datenbank" fungiert.
Hier gibt es 2 Tabellen.
Die erste Tabelle enthält die Datensätze (Bsp.: Früchte: Typ, Name, Farbe, Herkunft)
Die zweite Tabelle enthält zusätzliche infos (Bsp.: Zusatz: Flecken, Braun, links)
Für die erste Tabelle brauche ich 40 Eingabefelder, wovon 37 Comboboxen sind.
Für die zweite Tabelle brauche ich 88 Eingabefelder (4 Eingaben ergeben hier einen Datensatz)
Die 37 Comboboxen befülle ich mit den Daten des Tabellenblatts 1.
Die Daten werden in ein Dictionary geladen um redundanzen zu vermeiden.
Dann werden die Daten des Dictionary Sortiert per Quicksort.
Danach werden die Daten in die Combobox eingefügt.
Von den 88 Eingabfeldern, sind 44 Textboxen und 44 Comboboxen.
22 der 44 Textboxen werden nicht befüllt, die anderen 22 erhalten statische Werte.
Die Comboboxen werden dann je nach enthaltenem Wert der Textbox gefüllt (kleine Datenmengen, kaum relevant).
Beim Laden der UserForm führe ich einige Sachen aus.
Ich weise Klassenmodul EventHandler zu Controls hinzu, Färbe Controls und weise
Schriftarten etc. zu und Lade und Sortiere eben die Daten.
Bei einer Tabelle mit nur 1700 Zeilen, dauert dass ganze 0.7968 Sekunden...
Wenn ich das Sortieren rausnehme immer noch 0.4531 Sekunden...
Ich finde es dauert ziemlich lange und die Datenmenge wird natürlich immer größer.
Sollte man hier ein Limit machen?
So dass nur die letzten 1000 Datensätze in die Maske kommen?
Ich stelle euch hier noch ein wenig von meinem Code rein.
Wenn ihr eine Möglichkeit seht, da was zu verbessern, würde ich
mich natürlich sehr über vorschläge und verbesserungen freuen.
Daten in Dictionary:
Option Explicit
Private PrivateWorksheet_ As Worksheet
' Puts the values of a sheet into a given combobox
Public Sub ToCombobox(ByVal fromSheet As Worksheet, column_ As Long, cb As MSForms.ComboBox, _
Optional ByVal SortValues As Boolean, _
Optional ByVal SortDescending As Boolean)
If IsMissing(SortValues) Then SortValues = False
If IsMissing(SortDescending) Then SortDescending = False
'//Declare Variables
Dim dictionary_ As Dictionary
Dim varKey As Variant
'//Set the Sheet reference
Set PrivateWorksheet_ = fromSheet
Set fromSheet = Nothing
'//Create dictionary with the column Data
Set dictionary_ = GetColumnData(column_)
'//Sort the dictionary values
If SortValues Then Sort_.DicionaryByKey dictionary_, SortDescending
'If the dicitionary is not empty than add all the keys as values to the combo
If Not dictionary_ Is Nothing Then
For Each varKey In dictionary_.Keys
cb.AddItem varKey
Next varKey
End If
Set PrivateWorksheet_ = Nothing
End Sub
' Adds non redundant data to dictionary
Private Function GetColumnData(ByVal column_ As Long) As Dictionary
Dim dictionary_ As New Dictionary
Dim lRow As Long, i As Long
Dim tmp As String
lRow = LastRow(column_)
'//Add Data non redundat
With PrivateWorksheet_
For i = 2 To lRow
tmp = .Cells(i, column_).value
If tmp "" And Not dictionary_.Exists(tmp) Then
dictionary_.Add tmp, 0
End If
Next i
End With
Set GetColumnData = dictionary_
Set dictionary_ = Nothing
Set PrivateWorksheet_ = Nothing
End Function
' Last Row of given column
Private Function LastRow(ByVal column_ As Long) As Long
With PrivateWorksheet_
LastRow = .Cells(.Rows.Count, column_).End(xlUp).Row
End With
End Function
Sortieren:
Option Explicit
' Convert Dict To Array And Sort the Array
' Convert back to dict
Public Sub DicionaryByKey(ByRef dictionary_ As Dictionary, _
Optional ByVal SortDescending As Boolean)
If IsMissing(SortDescending) Then SortDescending = False
'// If its not valid then go out now!
If dictionary_ Is Nothing Then Exit Sub
If (dictionary_.Count = 0) Or (dictionary_.Count = 1) Then Exit Sub
'// Dictionary to Array
Dim array_() As String
array_ = ConvertToArray(dictionary_)
Set dictionary_ = Nothing
'// Sort array
ExecuteSorting array_, SortDescending
'// Array To Dictionary
Set dictionary_ = ConvertToDictionary(array_)
Erase array_
End Sub
' Convert Dict To Array
Private Function ConvertToArray(ByRef dictToConvert As Dictionary) As Variant
Dim array_() As String
Dim i As Long
ReDim array_(0 To dictToConvert.Count - 1)
For i = 0 To UBound(array_)
array_(i) = dictToConvert.Keys(i)
Next i
ConvertToArray = array_
End Function
' Convert Array To dict
Private Function ConvertToDictionary(ByRef array_() As String) As Dictionary
Dim dictionary_ As New Dictionary
Dim i As Long
For i = LBound(array_) To UBound(array_)
dictionary_.Add array_(i), 0
Next i
Set ConvertToDictionary = dictionary_
End Function
' Execute Sorting
Private Sub ExecuteSorting(ByRef array_() As String, ByVal SortDescending As Boolean)
'// Sorting Keys
If SortDescending Then
QuickSortDescending array_, LBound(array_), UBound(array_)
Else: QuickSortAscending array_, LBound(array_), UBound(array_)
End If
End Sub
' Sort in Ascending Order
Public Sub QuickSortAscending(ByRef array_() As String, _
Optional ByVal low As Long, _
Optional ByVal high As Long)
If IsMissing(low) Then low = LBound(array_)
If IsMissing(high) Then high = UBound(array_)
Dim i As Long: i = low
Dim j As Long: j = high
Dim tmp As String
Dim ref As String: ref = array_((low + high) / 2)
Do
While (array_(i) ref): j = j - 1: Wend
If (i j)
If (low ref): i = i + 1: Wend
While (array_(j) j)
If (low