napisał: r_c
postów: 38
 umieszczony:
12 czerwca 2005
18:25
|
|
Podane kody są przykładem tzw. sortowania siłowego czyli
nie najwydajnieszego. Istnieją inne bardziej wydajne
metody sortowania. Są one jednak o wiele bardziej skompli-
kowane. W kodzie umieściłem pomiar czasu,
gdyż wydaje mi się, że metoda sortowania arkuszowego jest
wydajniejsza.
Podejrzewam, że w internecie można trafić na o wiele bardziej
wydajne metody sortowania macierzy.
Na moim komputerze kod sortuje 1000 elementów ca 1 sek, ale już
3000 elementów ca 13 sek, a 10000 w 70 sek.
A tak nawiasem to nie podałeś co chcesz sortować: wartości,tekst.
kod nr 1:
sub SortujNajwiekszePierwsze()
Dim MojaTablica() As Variant
Dim IlePozycji As Single, MocPozycji As Single, Temp As Variant
Dim Czas As Double, IleCzasu As String
If ComboBox1.ListCount <= 0 Then Exit Sub
IlePozycji = ComboBox1.ListCount
ReDim MojaTablica(0 To IlePozycji - 1)
For i = 0 To IlePozycji - 1
MojaTablica(i) = ComboBox1.list(i)
Next i
Czas = Timer
Do
MocPozycji = 0
For i = 0 To IlePozycji - 2
If MojaTablica(i + 1) > MojaTablica(i) Then
MocPozycji = 1
Temp = MojaTablica(i)
MojaTablica(i) = MojaTablica(i + 1)
MojaTablica(i + 1) = Temp
End If
Next i
Loop Until MocPozycji = 0
With ComboBox1
.Clear
.list = MojaTablica
.ListIndex = 0
End With
IleCzasu = Format(Timer - Czas, "00:00") & " sek."
UserForm1.Caption = "Sortowanie" & ComboBox1.ListCount & " elementów " _
& " trwało " & IleCzas
End Sub
kod nr 2:
Dim Czas As Double
Dim LicznikCombo As Long
Dim IleCzasu As String
Sub Sortuj(Tablica() As String)
Dim Pierwszy As Long, Ostatni As Long
Dim Licznik1 As Long, Licznik2 As Long
Dim Chwilowe As String
Pierwszy = LBound(Tablica)
Ostatni = UBound(Tablica)
For Licznik1 = Pierwszy To Ostatni - 1
For Licznik2 = Licznik1 + 1 To Ostatni
If Val(Tablica(Licznik1)) < Val(Tablica(Licznik2)) Then
' w porządku malejacym; ' w porządku rosnącym >;' dla tekstu należy usunąć Val
' i wpisać kilka innch drobiazgów
Chwilowe = Tablica(Licznik2)
Tablica(Licznik2) = Tablica(Licznik1)
Tablica(Licznik1) = Chwilowe
End If
Next Licznik2
Next Licznik1
End Sub
Private Sub CommandButton1_Click()
Dim ListaCombo() As String
Dim licznik As Long
Czas = Timer
If ComboBox1.ListCount = 0 Then Exit Sub
ReDim ListaCombo(0 To LicznikCombo - 1)
For licznik = 0 To LicznikCombo - 1
ListaCombo(licznik) = ComboBox1.List(licznik)
Next licznik
Call Sortuj(ListaCombo)
With ComboBox1
.Clear
.List = ListaCombo
.ListIndex = 0
End With
IleCzasu = Format(Timer - Czas, "00:00:00")
UserForm1.Caption = "Elementów " & LicznikCombo _
& " w czasie " & IleCzasu & " sek."
End Sub
Private Sub UserForm_Initialize()
Dim Liczba As Long
Czas = Timer
For Liczba = 1 To 3000
ComboBox1.AddItem Liczba * Rnd
Next Liczba
If ComboBox1.ListCount = 0 Then Exit Sub
ComboBox1.ListIndex = 0
LicznikCombo = ComboBox1.ListCount
IleCzasu = Format(Timer - Czas, "00:00:00")
UserForm1.Caption = "Elementów " & LicznikCombo _
& " w czasie " & IleCzasu & " sek."
End Sub
kod nr 3: sortowanie arkuszowe 10000 elementów niecała 1 sek.
Private Sub CommandButton1_Click()
Dim Czas As Double, IleCzasu As String
Dim i As Integer
Dim M_Tablica As Variant
Dim IlePozycji As Integer
Dim Zakres As Range
IlePozycji = ComboBox1.ListCount
Czas = Timer
ActiveWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "temp"
ReDim M_Tablica(0 To IlePozycji - 1)
For i = 0 To IlePozycji - 1
M_Tablica(i) = ComboBox1.List(i)
Next i
Set Zakres = ActiveSheet.Range(Cells(1, 1), Cells(IlePozycji, 1))
Application.ScreenUpdating = False
Zakres.Value = Application.WorksheetFunction.Transpose(M_Tablica)
Zakres.Sort Key1:=Range("A1"), Order1:=xlDescending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Erase M_Tablica
M_Tablica = Zakres.Value
With ComboBox1
.Clear
.List = M_Tablica
.ListIndex = 0
End With
IleCzasu = Format(Timer - Czas, "00:00:00") & " sek."
UserForm1.Caption = "Sortowanie" & ComboBox1.ListCount _
& " elementów " & " trwało " & IleCzasu
Set Zakres = Nothing
Application.DisplayAlerts = False
Sheets("temp").Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Private Sub UserForm_Initialize()
Dim i As Integer
For i = 1 To 10000
ComboBox1.AddItem i * Rnd
Next i
ComboBox1.ListIndex = 0
End Sub
r_c |
|
|
napisał: tserek
postów: 3
umieszczony:
9 czerwca 2005
14:59
|
|
| Jak wyświetlić w combobox posortowaną rosnąco listę jeżeli nie chcę jej sortować w arkuszu |
|
|
 wstecz 1 dalej  wszystkich stron: 1
|
