Sıralamayı İstenen Satırdan Başlatma?

[ysfgk]

Merhaba arkadaşlar,

Excel'de bir sutundaki veriyi istediğim satırdan başlayarak nasıl sıralayabilirim?

Örneğim

2016/1-4323
2016/2-4234
2014/1-1533
2015/2-5434


Ben slashtan önceki yıldan değil de "1-" ve "2-"'den başlatmak istiyorum. sırala deyince slash'a kadar yeri yoksaysın, önce 1-'ler sonra 2-'ler sıralansın istiyoırum. Yardımcı olursanız çok sevinirim.

 

[Asri]

Veriler Sayfa1 A kolonunda ve kolon başlığı varsayılmıştır.

Dim veriler() As String

Sub Verileri_Sirala()
   Sheets("Sayfa1").Select
   verisonsatir = Cells(Rows.Count, "A").End(3).Row
   secim = "A2:A" & verisonsatir
   'veriler = Range(secim)
   ReDim veriler(1 To verisonsatir, 1 To 2) As String
   For i = 2 To verisonsatir
      gecici = Cells(i, 1).Value
      veriler(i - 1, 1) = gecici
      veriler(i - 1, 2) = Mid(gecici, InStr(gecici, "/") + 1, Len(gecici))
   Next i
   
   Call QuickSortArray(veriler, LBound(veriler), UBound(veriler), 2)
   For i = 2 To verisonsatir
      Cells(i, 2).Value = veriler(i, 1)
   Next i
End Sub


Public Sub QuickSortArray(ByRef SortArray As Variant, _
                                Optional lngMin As Long = -1, _
                                Optional lngMax As Long = -1, _
                                Optional lngColumn As Long = 0)
On Error Resume Next
Dim i           As Long
Dim j           As Long
Dim varMid      As Variant
Dim arrRowTemp  As Variant
Dim lngColTemp  As Long


 If IsEmpty(SortArray) Then
     Exit Sub
 End If

 If InStr(TypeName(SortArray), "()") < 1 Then  'IsArray() is somewhat broken:  Look for brackets in the type name
     Exit Sub
 End If

 If lngMin = -1 Then
     lngMin = LBound(SortArray, 1)
 End If
 
 If lngMax = -1 Then
     lngMax = UBound(SortArray, 1)
 End If
 
 If lngMin >= lngMax Then
     Exit Sub
 End If


 i = lngMin
 j = lngMax

 varMid = Empty
 varMid = SortArray((lngMin + lngMax) \ 2, lngColumn)

 
 If IsObject(varMid) Then
     i = lngMax
     j = lngMin
 ElseIf IsEmpty(varMid) Then
     i = lngMax
     j = lngMin
 ElseIf IsNull(varMid) Then
     i = lngMax
     j = lngMin
 ElseIf varMid = "" Then
     i = lngMax
     j = lngMin
 ElseIf VarType(varMid) = vbError Then
     i = lngMax
     j = lngMin
 ElseIf VarType(varMid) > 17 Then
     i = lngMax
     j = lngMin
 End If


 While i <= j

     While SortArray(i, lngColumn) < varMid And i < lngMax
         i = i + 1
     Wend

     While varMid < SortArray(j, lngColumn) And j > lngMin
         j = j - 1
     Wend


     If i <= j Then
         ReDim arrRowTemp(LBound(SortArray, 2) To UBound(SortArray, 2))
         For lngColTemp = LBound(SortArray, 2) To UBound(SortArray, 2)
             arrRowTemp(lngColTemp) = SortArray(i, lngColTemp)
             SortArray(i, lngColTemp) = SortArray(j, lngColTemp)
             SortArray(j, lngColTemp) = arrRowTemp(lngColTemp)
         Next lngColTemp
         Erase arrRowTemp

         i = i + 1
         j = j - 1

     End If

 Wend

 If (lngMin < j) Then Call QuickSortArray(SortArray, lngMin, j, lngColumn)
 If (i < lngMax) Then Call QuickSortArray(SortArray, i, lngMax, lngColumn)

End Sub

 

[1903emre34@gmail.com]

Asri bey, merhaba

Yılları sıralamak istersek, kodlarda nerede değişiklik yapabiliriz?

2014/1-1533
2015/2-5434
2016/1-4323
2016/2-4234

 

[Asri]

Asri bey, merhaba

Yılları sıralamak istersek, kodlarda nerede değişiklik yapabiliriz?

2014/1-1533
2015/2-5434
2016/1-4323
2016/2-4234

Buradaki 2 yi 1 yapın.

Call QuickSortArray(veriler, LBound(veriler), UBound(veriler), 2)