Not sıralama

[Yesilyurtlu]

Değerli üstadlarım
Ekli dosyada belirli kritere göre grup yapıp sıralamam lazım. Yardımcı olabilir misiniz?

 

[muygun]

Merhaba;
Eki inceleyin.
İyi çalışmalar.

 

[Ömer]

Merhaba,

Alternatif olsun.

Option Explicit
Sub Listele()
Dim i, sat1, sat2, sat3, sat4, sat5, sat6 As Long
Application.ScreenUpdating = False
Range("G4:Q65536").ClearContents
sat1 = 3: sat2 = 3: sat3 = 3: sat4 = 3: sat5 = 3: sat6 = 3
    For i = 1 To [A65536].End(3).Row
        If Cells(i, "a") < 25 Then
            sat1 = sat1 + 1
            Cells(sat1, "g") = Cells(i, "a")
        End If
        If Cells(i, "a") >= 25 And Cells(i, "a") < 45 Then
            sat2 = sat2 + 1
            Cells(sat2, "ı") = Cells(i, "a")
        End If
        If Cells(i, "a") >= 45 And Cells(i, "a") < 55 Then
            sat3 = sat3 + 1
            Cells(sat3, "k") = Cells(i, "a")
        End If
        If Cells(i, "a") >= 55 And Cells(i, "a") < 70 Then
            sat4 = sat4 + 1
            Cells(sat4, "m") = Cells(i, "a")
        End If
        If Cells(i, "a") >= 70 And Cells(i, "a") < 85 Then
            sat5 = sat5 + 1
            Cells(sat5, "o") = Cells(i, "a")
        End If
        If Cells(i, "a") >= 85 Then
            sat6 = sat6 + 1
            Cells(sat6, "q") = Cells(i, "a")
        End If
    Next i
Application.ScreenUpdating = True
End Sub

.

 

[Yesilyurtlu]

Değerli UZMANLARIM;

Allah razı olsun.muygun üstadıma da ömer üstadıma da teşekkür ederim.

 

[canlaracan]

not sıralama

kendi yaptığım not sıralamasını gönderiyom umarım işinize yarar
okulda başarı durumları için yaptığım uygulamaEkli dosyayı görüntüle 81005Ekli dosyayı görüntüle 81005

 

[canlaracan]

not sıralama

kendi yaptığım not sıralamasını gönderiyom umarım işinize yarar
okulda başarı durumları için yaptığım uygulama

 

[canlaracan]

not aralığı

az önce gönderdiklerimde ormüller silinmiş özür
şimdi doğrusunu göndermeye çalışıyom .