DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
evren bey müsadenizle onuda ben yazıyımYa 9 sütunlu bir listbox'sa
Private Sub CommandButton1_Click()
Liste = ListBox1.List 'Değişkenimize ListBox'taki listeyi aldık
ListBox1.RowSource = "" 'Eğer veriler bu metot ile alınmışsa bağlantıyı koparmamız gerekiyor
ListBox1.List = Sirala(Liste, ListBox1.ColumnCount, 1) ' a dan z ye sıralama burada 1. sutunu aldık
End Sub
Private Function Sirala(Liste As Variant, Sutun_Adedi As Byte, Siralanacak_Sutun_No As Byte)
Dim i As Integer, j As Integer, SAY As Byte, x As Variant
For i = LBound(Liste) To UBound(Liste) - 1
For j = i + 1 To UBound(Liste)
If StrComp(Liste(i, Siralanacak_Sutun_No - 1), Liste(j, Siralanacak_Sutun_No - 1), vbTextCompare) = 1 Then
For SAY = 0 To Sutun_Adedi - 1
x = Liste(j, SAY)
Liste(j, SAY) = Liste(i, SAY)
Liste(i, SAY) = x
Next
End If
Next j
Next i
Sirala = Liste
End Function
Merhaba,evren bey müsadenizle onuda ben yazıyım
kod
Kod:Private Sub CommandButton1_Click() Liste = ListBox1.List 'Değişkenimize ListBox'taki listeyi aldık ListBox1.RowSource = "" 'Eğer veriler bu metot ile alınmışsa bağlantıyı koparmamız gerekiyor ListBox1.List = Sirala(Liste, ListBox1.ColumnCount, 1) ' a dan z ye sıralama burada 1. sutunu aldık End Sub Private Function Sirala(Liste As Variant, Sutun_Adedi As Byte, Siralanacak_Sutun_No As Byte) Dim i As Integer, j As Integer, SAY As Byte, x As Variant For i = LBound(Liste) To UBound(Liste) - 1 For j = i + 1 To UBound(Liste) If StrComp(Liste(i, Siralanacak_Sutun_No - 1), Liste(j, Siralanacak_Sutun_No - 1), vbTextCompare) = 1 Then For SAY = 0 To Sutun_Adedi - 1 x = Liste(j, SAY) Liste(j, SAY) = Liste(i, SAY) Liste(i, SAY) = x Next End If Next j Next i Sirala = Liste End Function
If StrComp(Liste(i, Siralanacak_Sutun_No - 1), Liste(j, Siralanacak_Sutun_No - 1), vbTextCompare) = [COLOR="Red"][B][SIZE="3"]-[/SIZE][/B][/COLOR]1 Then
Private Sub CommandButton40_Click()
Liste = ListBox2.List 'Değişkenimize ListBox'taki listeyi aldık
ListBox2.RowSource = "" 'Eğer veriler bu metot ile alınmışsa bağlantıyı koparmamız gerekiyor
ListBox2.List = sirala(Liste, [COLOR=Red]1, [COLOR=DarkOrchid]True[/COLOR]) ' a dan z ye sıralama burada 1. sutunu aldık [/COLOR][COLOR=Purple]true=a-z sıralama[/COLOR]
End Sub
Private Sub CommandButton43_Click()
Liste = ListBox2.List 'Değişkenimize ListBox'taki listeyi aldık
ListBox2.RowSource = "" 'Eğer veriler bu metot ile alınmışsa bağlantıyı koparmamız gerekiyor
ListBox2.List = sirala(Liste,[COLOR=Red] 2,[COLOR=DarkOrchid] False[/COLOR]) ' a dan z ye sıralama burada 2. sutunu aldık [/COLOR][COLOR=Purple]false=z-a sıralama[/COLOR]
End Sub
[COLOR=Red]Private Function sirala(Liste As Variant, Optional Sutun As Byte = 1, Optional a_z As Boolean = True)
If LBound(Liste) = 0 Then Sutun = Sutun - 1
Dim i As Integer, j As Integer, say As Byte, temp As String
For i = LBound(Liste) To UBound(Liste) - 1
For j = i + 1 To UBound(Liste)
If StrComp(Liste(i, Sutun), Liste(j, Sutun), vbTextCompare) = IIf(a_z, 1, -1) Then
For say = LBound(Liste, 2) To UBound(Liste, 2)
temp = Liste(j, say)
Liste(j, say) = Liste(i, say)
Liste(i, say) = temp
Next
End If
Next j
Next i
sirala = Liste
End Function[/COLOR]