Soru Listboxta Sıralama Yaparken Sorun Yaşıyorum(BubbleSort)

[ywzyilmaz]

Merhaba

3 sütunlü listboxın ilk sütununda sıra numaraları. İkinci sütunda isimler, üçüncü sütunda tarihler var. Butona tıkladığımda listeyi sıra numaralarına göre artan düzende sıralamak istiyorum. Aşağıdaki kodlar ile tek sütunlu listboxta sıralama yapıyorum. Fakat 3 sütunlu listboxta yapmak için nasıl ilerlemeliyim bulamadım. Yardımcı olabilir misiniz?

Sub BubbleSort(myarray() As Variant)
Dim i As Long, j As Long
Dim Temp As Variant
 
For i = LBound(myarray) To UBound(myarray) - 1
    For j = i + 1 To UBound(myarray)
        If myarray(i) > myarray(j) Then
            Temp = myarray(j)
            myarray(j) = myarray(i)
            myarray(i) = Temp
        End If
    Next j
Next i
End Sub

 

[ywzyilmaz]

@Muzaffer Ali hocamın bu konuda verdiği kodları inceledim. Fakat ben listboxın içini veri tabanından çekip listeliyorum. Yani dolu listboxı tekrardan listelemek istiyorum.

 

[Korhan Ayhan]

Bu sıralama işlemini veri tabanından çekme aşamasında sanırım daha kolaylıkla yapabilirsiniz.

 

[veyselemre]

Private Sub btnAdoSırala_Click()
    Dim myArray
    myArray = ListBox1.List
    Call adoSort(myArray, ComboBox1.Text, CheckBox1.Value)
    ListBox1.Column = myArray
End Sub
Private Sub btnBubbleSort_Click()
    Dim myArray
    myArray = ListBox1.List
    Call BubbleSort(myArray, ComboBox1.ListIndex, CheckBox1.Value)
    ListBox1.List = myArray
End Sub

Private Sub UserForm_Initialize()
    Dim veri
    With Sheets("Data")
        veri = .Range("A2:C" & .Cells(Rows.Count, 1).End(3).Row).Value
    End With
    ListBox1.List = veri
    ComboBox1.List = Array("No", "AdSoyad", "Tarih")
    ComboBox1.ListIndex = 0
End Sub
Sub BubbleSort(ByRef myArray, idx As Byte, desc As Boolean)
    Dim i As Long, j As Long, k As Byte
    Dim Temp As Variant
    For i = LBound(myArray) To UBound(myArray) - 1
        For j = i + 1 To UBound(myArray)
            If (myArray(i, idx) > myArray(j, idx)) = Not desc Then
                For k = 0 To 2
                    Temp = myArray(j, k)
                    myArray(j, k) = myArray(i, k)
                    myArray(i, k) = Temp
                Next k
            End If
        Next j
    Next i
End Sub
Sub adoSort(ByRef myArray, alan, desc)
    Dim i&
    With CreateObject("ADODB.Recordset")
        .Fields.Append "No", 5
        .Fields.Append "AdSoyad", 129, 100
        .Fields.Append "Tarih", 7
        .Open
        For i = LBound(myArray) To UBound(myArray)
            .AddNew Array("No", "AdSoyad", "Tarih"), Array(myArray(i, 0), myArray(i, 1), myArray(i, 2))
        Next i
        .Sort = alan & IIf(desc, " DESC", "")
        myArray = .getrows
        .Close
    End With
End Sub