Koşullu soldan sağa sıralama

[kayserciyes]

ekdeki dosyamda öğrencilerin test cevapları var

1- H4 ile AF24 arasında ki veriler (dosyadaki yeşil alan) Soldan sağa 4.satıra göre sıralanacak

2- ancak sıkıntı burda başlıyor bu sıralama yapılırken F sutununda öğrencilerin kitapçık türleri var

Kitapçık türü B olan( yani F sutununda B yazan) öğrencilerin cevapları bu sıralama dışında tutulacak
sadece A yazanların cevaplar soldan sağa sıralanacak

cevaplayan olursa çok ikrama geçer
(örnekleri inceledim ama çözüm olmadı)

 

[Husgvarna]

ekdeki dosyamda öğrencilerin test cevapları var

Soldan sağa 4.satıra göre sıralanacak

Merhaba.
Yani "AI4" deki "NETLER" 'e göremi olacak..?

 

[kayserciyes]

yok hocam sadece
yeşil alan
(H4:AF24) soldan sağa satır 4. göre sıralancak
F sutununda B olanlar hariç

 

[kayserciyes]

Sub soldan_sırala()
Range("H4:AF24").Select
Selection.Sort Key1:=Range("H4"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, _
DataOption1:=xlSortNormal
End Sub

yukardaki makronun yaptığı işlem yapılacak sadece
ancak koşul şu ki
F sutununda B yazanlar yukardaki işleme tabi olmayacak onlar olduğu gibi kalacak

 

[kayserciyes]

Günaydın arakdaşlar
böyle bişey olmuyor mu yoksa bakan mı olmadı
biri incelerde olmaz derse başka bir yola bakacağım
herkese kolay gelsin

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub SAĞA_DOĞRU_ALFABETİK_SIRALA()
    Dim S1 As Worksheet, S2 As Worksheet, X As Long
    
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets.Add
    
    For X = 8 To S1.Cells(Rows.Count, 4).End(3).Row
        S1.Range("H7:AF7").Copy S2.Range("A1")
        If S1.Cells(X, 6) <> "B" Then
            S1.Range("H" & X & ":AF" & X).Copy S2.Range("A2")
            S2.Rows("1:2").Sort Key1:=S2.Range("A1"), Order1:=xlAscending, Header:=xlNo, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, DataOption1:=xlSortNormal
            S2.Range("A2:Y2").Copy S1.Cells(X, "H")
        End If
    
        S1.Range("AM7:BK7").Copy S2.Range("A1")
        If S1.Cells(X, 6) <> "B" Then
            S1.Range("AM" & X & ":BK" & X).Copy S2.Range("A2")
            S2.Rows("1:2").Sort Key1:=S2.Range("A1"), Order1:=xlAscending, Header:=xlNo, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, DataOption1:=xlSortNormal
            S2.Range("A2:Y2").Copy S1.Cells(X, "AM")
        End If
    
        S1.Range("BR7:CP7").Copy S2.Range("A1")
        If S1.Cells(X, 6) <> "B" Then
            S1.Range("BR" & X & ":CP" & X).Copy S2.Range("A2")
            S2.Rows("1:2").Sort Key1:=S2.Range("A1"), Order1:=xlAscending, Header:=xlNo, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, DataOption1:=xlSortNormal
            S2.Range("A2:Y2").Copy S1.Cells(X, "BR")
        End If
        
        S1.Range("CW7:DU7").Copy S2.Range("A1")
        If S1.Cells(X, 6) <> "B" Then
            S1.Range("CW" & X & ":DU" & X).Copy S2.Range("A2")
            S2.Rows("1:2").Sort Key1:=S2.Range("A1"), Order1:=xlAscending, Header:=xlNo, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, DataOption1:=xlSortNormal
            S2.Range("A2:Y2").Copy S1.Cells(X, "CW")
        End If
        
        S1.Range("EB7:EZ7").Copy S2.Range("A1")
        If S1.Cells(X, 6) <> "B" Then
            S1.Range("EB" & X & ":EZ" & X).Copy S2.Range("A2")
            S2.Rows("1:2").Sort Key1:=S2.Range("A1"), Order1:=xlAscending, Header:=xlNo, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, DataOption1:=xlSortNormal
            S2.Range("A2:Y2").Copy S1.Cells(X, "EB")
        End If
    Next
    
    S1.Range("H7:AF7").Sort Key1:=S1.Range("H7"), Order1:=xlAscending, Header:=xlNo, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, DataOption1:=xlSortNormal
    
    S1.Range("AM7:BK7").Sort Key1:=S1.Range("AM7"), Order1:=xlAscending, Header:=xlNo, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, DataOption1:=xlSortNormal
    
    S1.Range("BR7:CP7").Sort Key1:=S1.Range("BR7"), Order1:=xlAscending, Header:=xlNo, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, DataOption1:=xlSortNormal
    
    S1.Range("CW7:DU7").Sort Key1:=S1.Range("H7"), Order1:=xlAscending, Header:=xlNo, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, DataOption1:=xlSortNormal
    
    S1.Range("EB7:EZ7").Sort Key1:=S1.Range("EB7"), Order1:=xlAscending, Header:=xlNo, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, DataOption1:=xlSortNormal
    
    Application.DisplayAlerts = False
    S2.Delete
    Application.DisplayAlerts = True
    
    Set S1 = Nothing
    Set S2 = Nothing
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır."
End Sub

 

[kayserciyes]

KORHAN HOCAM istediğim tam da bu idi çok teşekkür ediyorum Allah razı olsun diğer uğraşan arkadaşlara çok Teşekkür ediyorum herkesin emeğine sağlık

 

[kayserciyes]

Korhan hocam
yazdığınız makroyu ben kendi programıma uygulayamadım
biliyorum fazla olacak ama siz ekdeki dosyama göre türkçe dersi için yaparsanız bende diğer dersler için hallederim. Bana çok karışık geldi bu kez
Hoş karşılayacağınız düşünerek şimdiden teşekkürler

 

[kayserciyes]

Hocam birde alta doğru öğrenci sayısı çoğalınca hata veriyor

 

[Korhan Ayhan]

Merhaba,

Üstteki mesajımdaki kodu son dosyanıza göre revize ettim. Denermisiniz.

 

[kayserciyes]

hocam bu sefer iyice mahcup ettiniz. Valla türkçe yeterdi siz beş derside yapmışınız
Allah razı olsun hocam.
Beş yıldır bu siteyi takip ederim yardım ve nezakette hemde web ortamında böylesi mükemmelliği sağlayabilen siteyi birakın çok az kurum görmüşümdür.
Yüzünüzü görmediğimiz için övmekde sakınca yok
Herkesin emeğine sağlık.
Hayırlı Akşamlar diiyorum Excel Web Tr ahalisine

 

[kayserciyes]

hocam tekrar teşekkürler
bugün yine aynı kod lazım oldu )