dakikaları şarta bağlı büyükten küçüğe sırala

[şehiriçi]

merhaba excel dostları , yine desteğinize başvuracağım bir sorum var
saat isimli dosyada A sütununda plakalar B sütununda saatler var . İstediğim şu: B sütunundaki saatlerin büyükten küçüğe göre sıralanması , ama bu sıralamayı yaparken A sütunu da B sütunu ile beraber değişecek . Cevap E ve F sütununa aktarılacak ve bu işlemler makrolu olacak

 

[Korhan Ayhan]

İki farklı kod örneği ektedir.

Dilediğinizi kullanabilirsiniz.

Option Explicit

Sub Sirala_Klasik_Yontem()
    Dim Zaman As Double
    Zaman = Timer
    Range("E2:F" & Rows.Count).Clear
    Range("A2:B" & Cells(Rows.Count, 1).End(3).Row).Copy Range("E2")
    Range("E2:F" & Rows.Count).Sort Range("E2"), xlAscending, Range("F2"), , xlDescending
    MsgBox "Veriler sıralanmıştır." & vbLf & vbLf & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub

Sub Sirala_Ado_Yontemi()
    Dim Baglanti As Object, Kayit_Seti As Object, Sorgu As String, Zaman As Double
    
    Zaman = Timer
    
    Application.ScreenUpdating = 0
    Application.Calculation = -4135
    
    Set Baglanti = CreateObject("AdoDb.Connection")
    Set Kayit_Seti = CreateObject("AdoDb.Recordset")
    
    Range("E2:F" & Rows.Count).Clear
    
    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;Hdr=No"""
          
    Sorgu = "Select * From [Sayfa1$A2:B] Order By F1 Asc,F2 Desc"

    Kayit_Seti.Open Sorgu, Baglanti, 1, 1
    
    If Kayit_Seti.RecordCount > 0 Then
        Range("E2").CopyFromRecordset Kayit_Seti
        Range("F2").Resize(Kayit_Seti.RecordCount).NumberFormat = "hh:mm:ss"
        Columns.AutoFit
        
        Application.Calculation = -4105
        Application.ScreenUpdating = 0
        
        MsgBox "Veriler sıralanmıştır." & vbLf & vbLf & _
               "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
    Else
        Application.Calculation = -4105
        Application.ScreenUpdating = 0
        
        MsgBox "Sıralama işlemi için uygun veri bulunamadı!", vbInformation
    End If
    
    If Kayit_Seti.State <> 0 Then Kayit_Seti.Close
    If Baglanti.State <> 0 Then Baglanti.Close
  
    Set Kayit_Seti = Nothing
    Set Baglanti = Nothing
End Sub

 

[şehiriçi]

Korhan bey , ilginize teşekkür ederim ama tekrar kontrol eder misiniz verdiğiniz kod'lar istediğim gibi değil
istediğim sıralama dakikaları büyükten küçüğe doğru vermeli ve hangi dakika hangi araca ait se onuda karşısına getirebilmeli , teşekkürler

 

[Ömer]

Merhaba,

Sırala kodlarını aşağıdaki gibi değiştirip deneyiniz.

Sub Sirala_Klasik_Yontem()
    Dim Zaman As Double
    Zaman = Timer
    Application.ScreenUpdating = False
    Range("E2:F" & Rows.Count).Clear
    Range("A2:B" & Cells(Rows.Count, 1).End(3).Row).Copy Range("E2")
    Range("E2:F" & Rows.Count).Sort Range("F2"), xlDescending, Range("E2"), , xlAscending
    MsgBox "Veriler sıralanmıştır." & vbLf & vbLf & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
    Application.ScreenUpdating = True
End Sub

Sub Sirala_Ado_Yontemi()
    Dim Baglanti As Object, Kayit_Seti As Object, Sorgu As String, Zaman As Double
    
    Zaman = Timer
    
    Application.ScreenUpdating = 0
    Application.Calculation = -4135
    
    Set Baglanti = CreateObject("AdoDb.Connection")
    Set Kayit_Seti = CreateObject("AdoDb.Recordset")
    
    Range("E2:F" & Rows.Count).Clear
    
    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;Hdr=No"""
          
    Sorgu = "Select * From [Sayfa1$A2:B] Order By F2 Desc,F1 Asc"

    Kayit_Seti.Open Sorgu, Baglanti, 1, 1
    
    If Kayit_Seti.RecordCount > 0 Then
        Range("E2").CopyFromRecordset Kayit_Seti
        Range("F2").Resize(Kayit_Seti.RecordCount).NumberFormat = "hh:mm:ss"
        Columns.AutoFit
        
        Application.Calculation = -4105
        Application.ScreenUpdating = 0
        
        MsgBox "Veriler sıralanmıştır." & vbLf & vbLf & _
               "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
    Else
        Application.Calculation = -4105
        Application.ScreenUpdating = 0
        
        MsgBox "Sıralama işlemi için uygun veri bulunamadı!", vbInformation
    End If
    
    If Kayit_Seti.State <> 0 Then Kayit_Seti.Close
    If Baglanti.State <> 0 Then Baglanti.Close
 
    Set Kayit_Seti = Nothing
    Set Baglanti = Nothing
End Sub

 

[şehiriçi]

ömer bey , teşekkürler

 

[şehiriçi]

ömer bey şu göndereceğim dosyaya bir bakar mısın .

 

[Ömer]

A3 hücresindeki veride;

1.01.1900 03:26:59

tarih de var. Bundan dolayı diğer verilerden daha büyük. Tarihi silerek sadece 03:26:59 bırakırsanız istediğiniz sonucu alırsınız.

 

[şehiriçi]

evet ömer bey bende sonradan farkettim çok teşekkürler . benim dosyamda veri çektiğim hücrede tarih ve saat bitişik olmasından kaynaklı olduğunu gördüm ve gerekli düzeltmemi yaptım teşekkürler