ComboBox - das Füllen dauert sehr lange
09.02.2009 09:56:01
tco99
Hallo zusammen,
ich habe in einer Userform eine ComboBox, die mit Werten aus den Spalten des ersten Worksheets gefüllt wird. Dabei werden doppelte Werte ausgefiltert und die Liste sortiert. Das Makro habe ich gefunden und für mich angepasst. Es funktioniert auch, jedoch braucht es sehr lange, bis die ComboBox gefüllt ist. Es dauert so ca. 10 Sekunden, wenn ich die Spalten A bis G haben möchte. So sieht mein Code aus:
Sub ComboBoxGerätetypenFüllen()
Übersicht.ComboBox2.Clear
'Werte aus Spalte A
Dim dic As Object
Dim xKey As Variant
Dim iRow As Long, ALetzte As Long
ALetzte = IIf(IsEmpty(Range("A65536")), Range("A65536").End(xlUp).Row, 65536)
Set dic = CreateObject("scripting.dictionary")
For iRow = 1 To ALetzte
If Not IsEmpty(Cells(iRow, 1)) Then
xKey = Cells(iRow, 1).Value
dic(xKey) = 0
End If
Next
For Each xKey In dic
Übersicht.ComboBox2.AddItem xKey
Next
dic.RemoveAll
Set dic = Nothing
'Werte aus Spalte B
Dim dic As Object
Dim xKey As Variant
Dim iRow As Long, ALetzte As Long
ALetzte = IIf(IsEmpty(Range("B65536")), Range("B65536").End(xlUp).Row, 65536)
Set dic = CreateObject("scripting.dictionary")
For iRow = 1 To ALetzte
If Not IsEmpty(Cells(iRow, 2)) Then
xKey = Cells(iRow, 2).Value
dic(xKey) = 0
End If
Next
For Each xKey In dic
Übersicht.ComboBox2.AddItem xKey
Next
dic.RemoveAll
Set dic = Nothing
'Werte aus Spalte C
Dim dic As Object
Dim xKey As Variant
Dim iRow As Long, ALetzte As Long
ALetzte = IIf(IsEmpty(Range("C65536")), Range("C65536").End(xlUp).Row, 65536)
Set dic = CreateObject("scripting.dictionary")
For iRow = 1 To ALetzte
If Not IsEmpty(Cells(iRow, 3)) Then
xKey = Cells(iRow, 3).Value
dic(xKey) = 0
End If
Next
For Each xKey In dic
Übersicht.ComboBox2.AddItem xKey
Next
dic.RemoveAll
Set dic = Nothing
Call ComboBoxGerätetypenSortieren
Übersicht.ComboBox2.ListIndex = 0
Übersicht.ComboBox2 = ""
End Sub
Sub ComboBoxGerätetypenSortieren()
Dim Letzter As Integer, Naechster As Integer
Dim i As String
With Übersicht.ComboBox2
For Letzter = 0 To .ListCount - 1
For Naechster = Letzter + 1 To .ListCount - 1
If .List(Letzter) > .List(Naechster) Then
i = .List(Letzter)
.List(Letzter) = .List(Naechster)
.List(Naechster) = i
End If
Next Naechster
Next Letzter
End With
End Sub
Ich habe den Code hier gekürzt hineinkopiert, frage normalerweise Spalten A bis E und G bis H ab.
Ich habe versucht, selbst für mehr Geschwindigkeit zu sorgen, in dem ich die folgende Zeile angepasst habe, jedoch ohne Erfolg:
Vorher:
ALetzte = IIf(IsEmpty(Range("A65536")), Range("A65536").End(xlUp).Row, 65536)
Nachher:
ALetzte = IIf(IsEmpty(Range("A2000")), Range("A2000").End(xlUp).Row, 2000)
Und so weiter ...
Hat jemand eine Idee, warum das trotzdem so lange dauert, auch wenn ich nur bis Zeile 2000 durchsuchen lasse?
Gruß
Erdogan