Private Sub userform_Initialize() kodunu silip alttaki kodu ekleyin.
Function kodunuda boş bir yere ekleyin alfabetik sıralama için.
Bu kodlar userform açılışı için sadece.Hem hızlı çalışır hemde alfabetik sıralama yapar.
Comboboxların değiştirilme olayına görede aynı mantıkla uygulanabilinir.
5000 satır için userform açılma süresi bende 1 veya 2 saniye sürdü.
- Kod: Tümünü seç
Private Sub userform_Initialize()
Dim combo2 As Object, combo3 As Object, combo4 As Object, a, b, c
Set combo2 = CreateObject("Scripting.Dictionary")
Set combo3 = CreateObject("Scripting.Dictionary")
Set combo4 = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = True
For i = 2 To Sayfa1.[A65536].End(3).Row
combo2.Item(Sayfa1.Cells(i, "A").Value) = Sayfa1.Cells(i, "A").Value
combo3.Item(Sayfa1.Cells(i, "C").Value) = Sayfa1.Cells(i, "C").Value
combo4.Item(Sayfa1.Cells(i, "B").Value) = Sayfa1.Cells(i, "B").Value
Next
a = combo2.items
b = combo3.items
c = combo4.items
Call xx(a)
Call xx(b)
Call xx(c)
On Error Resume Next
ComboBox2.List = a
ComboBox3.List = b
ComboBox4.List = c
Application.ScreenUpdating = True
Set combo2 = Nothing: Set combo3 = Nothing: Set combo4 = Nothing: Erase a: Erase b: Erase c
End Sub
- Kod: Tümünü seç
Function xx(yy As Variant)
For i = LBound(yy) To UBound(yy) - 1
For j = i + 1 To UBound(yy)
If StrComp(yy(i), yy(j), vbTextCompare) = 1 Then
x = yy(j)
yy(j) = yy(i)
yy(i) = x
End If
Next j
Next i
End Function