• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

En Büyük 20 Kayıt

  • Konbuyu başlatan Konbuyu başlatan cimcoz
  • Başlangıç tarihi Başlangıç tarihi
cimcoz

cimcoz

Altın Üye
Katılım
6 Ekim 2004
Mesajlar
324
Excel Vers. ve Dili
MS Office Plus 2016 & Mac OSX
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,
 

Ekli dosyalar

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

Ekli dosyalar

Merhaba,
Sanırım bu daha iyi. Deneyiniz.
İyi çalışmalar
 
Merhaba,
Dosyayı eklemeden göndermişim. Kusura bakmayın lütfen.
İyi çalışmalar
 

Ekli dosyalar

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.
 

Ekli dosyalar

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.
Genişletmek için tıkla ...

Sayın Korhan Ayhan,

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

221568


Saygılarımla,
 
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.
 
Sizin sisteminize uygun olan ekli dosyayı deneyiniz. Umarım bu sorun çıkarmadan çalışır.
 

Ekli dosyalar

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

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,



221574


221573
 
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.
 
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
 
Ben de dosyayı revize etmiştim.

Dilediğiniz çözümü kullanabilirsiniz.
 

Ekli dosyalar

Ö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
Genişletmek için tıkla ...


Sayın Ömer,

Sınıf konusunu kaldırdım. Sadece İsim ve aldığı yüzdeye göre sıralama yaptırmaya karar verdim.
 
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.
Genişletmek için tıkla ...

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,
 
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.
Genişletmek için tıkla ...

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
 
Ö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
Genişletmek için tıkla ...


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,
 

Ekli dosyalar

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,
Genişletmek için tıkla ...

Düzelttim.
 

Ekli dosyalar

Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst