En Büyük 20 Kayıt

cimcoz · 4 Ekim 2020

Merhaba,

Ekteki dosyama göre;

V sütunundaki yüzdelere göre ilk 20 yüzdeyi X16’dan itibaren ilk 20 kayıdı büyükten küçüğe ve bunlara ait R sütunundaki isimleri de yüzdelere göre (yani %100 onların adları A’dan Z’ye gibi ) alfabetik olarak sıralatmak istiyorum. Aynı zamanda bu yüzdelere ait öğrenci ve sınıf isimlerini de yanlarına ekleyen bir fonksiyon/makro konusunda yardımlarınızı rica ederim.

Saygılarımla,

Tevfik_Kursun · 4 Ekim 2020

Merhaba,
Umarım işinizi görür.
İyi çalışmalar

Tevfik_Kursun · 4 Ekim 2020

Merhaba,
Sanırım bu daha iyi. Deneyiniz.
İyi çalışmalar

Tevfik_Kursun · 4 Ekim 2020

Merhaba,
Dosyayı eklemeden göndermişim. Kusura bakmayın lütfen.
İyi çalışmalar

Korhan Ayhan · 5 Ekim 2020

Alternatif;

Dosyanızda küçük bir düzenleme yaptım. Sınıf isimlerini adların solundaki boş kısma yazdım. (Yeri değiştirilebilir)

Bu haliyle ADO ile hızlı bir şekilde sonuca gidilebiliyor. Belki kullanmak istersiniz.

cimcoz · 5 Ekim 2020

Tevfik_Kursun' Alıntı:
Merhaba,
Dosyayı eklemeden göndermişim. Kusura bakmayın lütfen.
İyi çalışmalar

Sayın Tevfik_Kursun,

Maalesef çalışmadı. İşletim sistemi macOS olduğundan olabilir.

Saygılarımla,

cimcoz · 5 Ekim 2020

Korhan Ayhan' Alıntı:
Alternatif;

Dosyanızda küçük bir düzenleme yaptım. Sınıf isimlerini adların solundaki boş kısma yazdım. (Yeri değiştirilebilir)

Bu haliyle ADO ile hızlı bir şekilde sonuca gidilebiliyor. Belki kullanmak istersiniz.

Sayın Korhan Ayhan,

Teşekkür ederim yalnız aşağıdaki hatayı almaktayım.

Saygılarımla,

Korhan Ayhan · 5 Ekim 2020

Sizin Mac-OSX kullandığınızı hep unutuyorum. Kusura bakmayın benim önerdiğim kod sizin sistemde çalışmayacaktır.

Not: Paylaştığım dosyada kodları butona tanımlamayı unutmuşum. Yeniden dosyayı revize ettim.

Korhan Ayhan · 5 Ekim 2020

Sizin sisteminize uygun olan ekli dosyayı deneyiniz. Umarım bu sorun çıkarmadan çalışır.

cimcoz · 5 Ekim 2020

Korhan Ayhan' Alıntı:
Sizin sisteminize uygun olan ekli dosyayı deneyiniz. Umarım bu sorun çıkarmadan çalışır.

Sayın Korhan Ayhan,

Maalesef sonuç aynıydı. Aslında ilginç olan tanımlı macro tuşa tanımlı gözükmüyor ve yeniden tanımlamak istediğimde de macro listede yer almıyor. Türkçe karakterlerden midir? bilemedim.

Sonrasında, yeni bir dosya oluşturup, macroyu oraya tanımladım ve çalıştı.

Ellerinize sağlık, çok teşekkür ederim.

Eğer mümkünse aşağıdaki ufak değişikliği rica edeceğim:
Zira 19 tane sınıf var ve mevcut örnekte 2 Sınıf olduğundan diğer sınıfları makrodan türetmeye çalıştım ama başarılı olamadım.
Bu yüzden SINIF sütununa bakılmaksızın R isim istesinin V yüzdelerini aynı şekilde Top 20 olarak sıralatmam gerekiyor.
Mevcut macroda V sütunu ve R sütununu SINIF isimleri olmadan listeletsem nereyi değiştirmem yeterlidir?

Saygılarımla,

Korhan Ayhan · 5 Ekim 2020

Sınıflardaki satır sayıları değişken mi?

Zira paylaştığınız dosyanızda Sınıf-1 20 kişilik, Sınıf-2 ise 21 kişilik görünüyor.

Sanırım bu satır sayıları değişkenlik gösteriyor.

Ömer · 5 Ekim 2020

Merhaba,

Eğer sıralama işin içinde olmasaydı, formülle de yapılabilirdi. Sıralamaya rağmen formülle de yapılabilir fakat şartlar olduğu için sıralama öncesi yardımcı sütun kullanmak gerekeceği için yapmadım.

Deneyiniz. Sınıf adıyla ilgili kesin bir bilgi olmadığı için örneğe göre ilerledim.

Kod:

Sub yaz()
   
    Dim son As Long, s As Byte, a As Double, c As Range, Adr As String, i As Byte, sinif As String
   
    son = Cells(Rows.Count, "V").End(xlUp).Row
    ReDim dizi(1 To 20, 1 To 3)
   
    Application.ScreenUpdating = False
    Range("X16:Z35").ClearContents
   
    s = 1
    For i = 1 To 20
        a = WorksheetFunction.Large(Range("V3:V" & son), s)
        Set c = [V:V].Find(Format(a, "0%"), , xlValues, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                dizi(s, 1) = Format(a, "0%")
                dizi(s, 2) = Cells(c.Row, "R")
                sinif = Evaluate("=LOOKUP(2,1/(SEARCH(""sınıf"", Q2:Q" & c.Row & ")),Q2:Q" & c.Row & ")")
                dizi(s, 3) = sinif
                s = s + 1
                Set c = [V:V].FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
        If s > 20 Then Exit For
    Next i
   
    Range("X16").Resize(s - 1, 3) = dizi
    Range("X16:Z35").Sort Key1:=Range("X15"), Order1:=xlDescending, _
                        Key2:=Range("Y15"), Order2:=xlAscending
End Sub

Korhan Ayhan · 5 Ekim 2020

Ben de dosyayı revize etmiştim.

Dilediğiniz çözümü kullanabilirsiniz.

cimcoz · 5 Ekim 2020

Korhan Ayhan' Alıntı:
Ben de dosyayı revize etmiştim.

Dilediğiniz çözümü kullanabilirsiniz.

Sayın Korhan Ayhan,

Ellerinize sağlık süper oldu. Bayağı zamanınızı aldım, hakkınızı helal edin.

Saygılarımla,

cimcoz · 5 Ekim 2020

Ömer' Alıntı:

Merhaba,

Eğer sıralama işin içinde olmasaydı, formülle de yapılabilirdi. Sıralamaya rağmen formülle de yapılabilir fakat şartlar olduğu için sıralama öncesi yardımcı sütun kullanmak gerekeceği için yapmadım.

Deneyiniz. Sınıf adıyla ilgili kesin bir bilgi olmadığı için örneğe göre ilerledim.

Kod:

Sub yaz()
  
    Dim son As Long, s As Byte, a As Double, c As Range, Adr As String, i As Byte, sinif As String
  
    son = Cells(Rows.Count, "V").End(xlUp).Row
    ReDim dizi(1 To 20, 1 To 3)
  
    Application.ScreenUpdating = False
    Range("X16:Z35").ClearContents
  
    s = 1
    For i = 1 To 20
        a = WorksheetFunction.Large(Range("V3:V" & son), s)
        Set c = [V:V].Find(Format(a, "0%"), , xlValues, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                dizi(s, 1) = Format(a, "0%")
                dizi(s, 2) = Cells(c.Row, "R")
                sinif = Evaluate("=LOOKUP(2,1/(SEARCH(""sınıf"", Q2:Q" & c.Row & ")),Q2:Q" & c.Row & ")")
                dizi(s, 3) = sinif
                s = s + 1
                Set c = [V:V].FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
        If s > 20 Then Exit For
    Next i
  
    Range("X16").Resize(s - 1, 3) = dizi
    Range("X16:Z35").Sort Key1:=Range("X15"), Order1:=xlDescending, _
                        Key2:=Range("Y15"), Order2:=xlAscending
End Sub

Sayın Ömer,

Sınıf konusunu kaldırdım. Sadece İsim ve aldığı yüzdeye göre sıralama yaptırmaya karar verdim.

cimcoz · 5 Ekim 2020

Korhan Ayhan' Alıntı:
Sınıflardaki satır sayıları değişken mi?

Zira paylaştığınız dosyanızda Sınıf-1 20 kişilik, Sınıf-2 ise 21 kişilik görünüyor.

Sanırım bu satır sayıları değişkenlik gösteriyor.

Sayın Korhan Ayhan,

Doğrudur sınıf mevcudu her sınıfta değişken. Son yaptığınız işimi gördü zira sütuna göre kontrol ettiğimiz için sınıf mevcudu dikkate alınmıyor. Sadece öğrenci adı ve yüzdeleri ilk 20 olarak sıralıyor.

Bu bölüm R ve V sütununa bakıyor yanlış yorumlamadıysam.

Son = S1.Cells(S1.Rows.Count, "R").End(3).Row
If Son = 3 Then Son = 4

Veri = S1.Range("R3:V" & Son).Value

Saygılar,

Korhan Ayhan · 5 Ekim 2020

Evet doğrudur...

Ömer · 5 Ekim 2020

cimcoz' Alıntı:
Sayın Ömer,

Sınıf konusunu kaldırdım. Sadece İsim ve aldığı yüzdeye göre sıralama yaptırmaya karar verdim.

Değiştirdim, ekteki gibi kullanabilirsiniz.

Kod:

Sub yaz()
    
    Dim son As Long, s As Byte, a As Double, c As Range, Adr As String, i As Byte
    
    son = Cells(Rows.Count, "V").End(xlUp).Row
    ReDim dizi(1 To 20, 1 To 2)
    
    Application.ScreenUpdating = False
    Range("X16:Z35").ClearContents
    
    s = 1
    For i = 1 To 20
        a = WorksheetFunction.Large(Range("V3:V" & son), s)
        Set c = [V:V].Find(Format(a, "0%"), , xlValues, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                dizi(s, 1) = Format(a, "0%")
                dizi(s, 2) = Cells(c.Row, "R")
                s = s + 1
                If s > 20 Then Exit For
                Set c = [V:V].FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
    Next i
    
    Range("X16").Resize(s - 1, 2) = dizi
    Range("X16:Z35").Sort Key1:=Range("X15"), Order1:=xlDescending, _
                        Key2:=Range("Y15"), Order2:=xlAscending
End Sub

cimcoz · 5 Ekim 2020

Ömer' Alıntı:

Değiştirdim, ekteki gibi kullanabilirsiniz.

Kod:

Sub yaz()
   
    Dim son As Long, s As Byte, a As Double, c As Range, Adr As String, i As Byte
   
    son = Cells(Rows.Count, "V").End(xlUp).Row
    ReDim dizi(1 To 20, 1 To 2)
   
    Application.ScreenUpdating = False
    Range("X16:Z35").ClearContents
   
    s = 1
    For i = 1 To 20
        a = WorksheetFunction.Large(Range("V3:V" & son), s)
        Set c = [V:V].Find(Format(a, "0%"), , xlValues, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                dizi(s, 1) = Format(a, "0%")
                dizi(s, 2) = Cells(c.Row, "R")
                s = s + 1
                Set c = [V:V].FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
        If s > 20 Then Exit For
    Next i
   
    Range("X16").Resize(s - 1, 2) = dizi
    Range("X16:Z35").Sort Key1:=Range("X15"), Order1:=xlDescending, _
                        Key2:=Range("Y15"), Order2:=xlAscending
End Sub

Sayın Ömer,

Teşekkür ederim, ilk denememde hata verdi. Sayfayı ve makroyu yeni bir dosyaya kopyalayıp çalıştırdım..
Yalnız, 67'den küçük hücreleri 67 ve ve üstü yapınca makro hatası veriyor ve çalışmıyor.

Saygılar,

Ömer · 5 Ekim 2020

cimcoz' Alıntı:
Sayın Ömer,

Teşekkür ederim, ilk denememde hata verdi. Sayfayı ve makroyu yeni bir dosyaya kopyalayıp çalıştırdım..
Yalnız, 67'den küçük hücreleri 67 ve ve üstü yapınca makro hatası veriyor ve çalışmıyor.

Saygılar,

Düzelttim.

En Büyük 20 Kayıt

cimcoz

Ekli dosyalar

Tevfik_Kursun

Ekli dosyalar

Tevfik_Kursun

Tevfik_Kursun

Ekli dosyalar

Korhan Ayhan

Administrator

Ekli dosyalar

cimcoz

cimcoz

Korhan Ayhan

Administrator

Korhan Ayhan

Administrator

Ekli dosyalar

cimcoz

Korhan Ayhan

Administrator

Ömer

Moderatör

Korhan Ayhan

Administrator

Ekli dosyalar

cimcoz

cimcoz

cimcoz

Korhan Ayhan

Administrator

Ömer

Moderatör

cimcoz

Ekli dosyalar

Ömer

Moderatör

Ekli dosyalar