[ÇÖZÜLDÜ] otomatik süzme işlemi

[yalovam77]

Ekteki dosyada genel isimli sayfada tüm okulun haftalık ders programı var derslik sayfasında ise J7 hücresine derslik adını yazıp tıkladığımızda istediğimiz derslikteki dersleri süzüyor ancak haftanın günlerine göre ve saatlere göre listelemesini istiyorum yani pazartesi,Salı,Çarşamba,Perşembe,cuma ve bunlarıda kendi içinde küçükten başlayarak büyük saate doğru listelemesini istiyorum (aynı saatte olan dersler vardır , saatler aynı olsada dersler farklıdır o yüzden aynı saat olanları altalta sıralaması gerekiyor) sabrınız ve emeğiniz için şimdiden teşekkür ederim.

 

[Korhan Ayhan]

Selamlar,

Kullandığınız kodu aşağıdaki şekilde değiştirip denermisiniz.

Sub AKTAR()
    Dim S1, S2 As Worksheet
    Dim SUT, S, SIRA As Integer
    Set S1 = Sheets("DERSLİK")
    Set S2 = Sheets("GENEL")
    S1.[A3:H43].ClearContents
    For SUT = 3 To S2.Cells(65536, "H").End(3).Row
    If S2.Cells(SUT, "H") = S1.[J7] Then
    S = S + 1
    S1.Cells(S + 2, "B") = S2.Cells(SUT, "B")
    S1.Cells(S + 2, "C") = S2.Cells(SUT, "C")
    S1.Cells(S + 2, "D") = S2.Cells(SUT, "D")
    S1.Cells(S + 2, "E") = S2.Cells(SUT, "E")
    S1.Cells(S + 2, "F") = S2.Cells(SUT, "F")
    S1.Cells(S + 2, "G") = S2.Cells(SUT, "G")
    S1.Cells(S + 2, "H") = S2.Cells(SUT, "H")
    End If
    Next
    For SIRA = 1 To S1.Cells(65536, "H").End(3).Row
    S1.Cells(SIRA + 2, "A") = SIRA
    Next
    Range("B3:H" & S1.[H65536].End(3).Row).Sort Key1:=S1.Range("B3"), Order1:=xlAscending, Key2:=S1.Range("C3") _
    , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=3, MatchCase:=False _
    , Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
End Sub