Sıralama

[korhan1981]

Ek'teki dosyada açıkladığım gibi bir sıralama makrosu yapabilirmisiniz. şimdiden teşekkürler...

 

[Orion1]

Aşağıdaki kodları bir deneyiniz.

Sub rutbe()
Dim son As Byte, i As Byte, myarr() As String, a As Byte
Dim j As Byte, x As Variant, z As Byte, sat As Byte
son = Cells(65536, "J").End(xlUp).Row
ReDim myarr(1 To 3, 1 To 1)
For i = 16 To son
    If IsNumeric(Cells(i, "J").Value) Then
         a = a + 1
         ReDim Preserve myarr(1 To 3, 1 To a)
         myarr(1, a) = CInt(Cells(i, "J").Value)
         myarr(2, a) = Cells(i, "K").Value
         myarr(3, a) = Cells(i, "L").Value
    End If
Next i
For i = LBound(myarr, 2) To UBound(myarr, 2) - 1
    For j = i + 1 To UBound(myarr, 2)
        If CInt(myarr(1, i)) > CInt(myarr(1, j)) Then
            For z = 1 To 3
                x = myarr(z, i)
                myarr(z, i) = myarr(z, j)
                myarr(z, j) = x
            Next z
        End If
    Next j
Next i
sat = 16
Range("B16:C35") = ""
For i = LBound(myarr, 2) To UBound(myarr, 2)
    For z = 2 To 3
        Cells(sat, z) = myarr(z, i)
    Next z
    sat = sat + 1
Next i
MsgBox "İşlem tamam"
End Sub