En İyi 3 Öğrenciyi ve Notlarını Listeleme

odevci · 24 Ara 2023

Merhaba,

Elimde aşağıdaki resimde göreceğiniz şekilde öğrenci isimleri, dersler ve o derslerden aldıkları notlar var.

Yapmak istediğim, bu veri tablosundaki en yüksek 3 puanı almış öğrencileri, ders isimlerini ve aldıkları puanları yazdıran yeni bir tablo oluşturmak. Yani aşağıdaki gibi:

Burada dikkat edilmesi gereken en önemli husus, farklı öğrenciler aynı puanı almış olabilir.. O zaman hepsi yazdırılmalı. İkinci olarak ise, aynı öğrenci, farklı bir puan ile listeye girebilir. O da yazdırılmalı.

Çözümün ne olacağı benim için önemli değil, yardımlarınızı rica ederim.

Teşekkürler.

ezelk · 24 Ara 2023

Tercih ederseniz, aşağıdaki Power Query M kodunu kullanarak istediğiniz sonucu alabilirsiniz.

VBA:

let
 Kaynak = Excel.CurrentWorkbook(){[Name="Tablo1"]}[Content],
 Tablo = Table.UnpivotOtherColumns(Kaynak, {"Öğrenciler"}, "Dersler", "Notlar"),
 Sırala = Table.Sort(Tablo,{{"Notlar", 1}, {"Öğrenciler", 0}, {"Dersler", 0}}),
 Sonuç = Table.SelectRows(Sırala, each [Notlar] >= List.FirstN(List.Distinct(Sırala[Notlar]),3){2})
in
 Sonuç

Mehmet · 24 Ara 2023

Kod:

=LET(a;METİNBÖL(METİNBİRLEŞTİR("*";1;A2:A10&"-"&B1:E1&"-"&B2:E10);"-";"*");b;SÜTUNSEÇ(a;3)*1;DÜŞEYYIĞ(YATAYYIĞ("Öğrenci";"Ders";"Not");SIRALA(FİLTRE(a;b>=BÜYÜK(BENZERSİZ(b);3));{3;1;2};{-1;1;1})))

Excel 365 formülü.

odevci · 24 Ara 2023

Hocalarım, @ezelk , @Mehmet çok teşekkür ederim her ikinize de.
Power Query'ye çok hakim değilim ama öğrenmekte istiyorum. Tabi öğrenmekten kastım, kod yazabilmeyi değil

Bu benim için çok zor bir husus. Nereye ekleyeceğim, ne şekilde çalıştıracağım kısmını.

halily · 24 Ara 2023

Dilerim işinize yarar
1 - verileri alıp dizilere aktaran yordam

VBA:

Sub SiralaDz()
Dim Syf As Worksheet: Set Syf = ThisWorkbook.Worksheets("sayfa1")
Dim DzTmp As Variant
Dim DzAna As Variant
Dim SonDz As Variant
Dim SonStr As Long

With Syf
SonStr = .Cells(.Rows.Count, 1).End(xlUp).Row
DzTmp = .Range("A1:E" & SonStr).Value2
.Range("G2:I" & SonStr).Cells.ClearContents
ReDim DzAna(1 To (UBound(DzTmp) - 1) * 4, 1 To 3)

    For xStr = 2 To UBound(DzTmp)
        For yStn = 2 To 5
        t = t + 1
            DzAna(t, 1) = DzTmp(xStr, 1)
            DzAna(t, 2) = DzTmp(1, yStn)
            DzAna(t, 3) = DzTmp(xStr, yStn)
        Next yStn

    Next xStr
    SonDz = DiziSirala(DzAna)
    .Range("G2:I2").Resize(UBound(SonDz)) = SonDz
End With
End Sub

2 - Dizi sırama yordamı

VBA:

Function DiziSirala(Dz As Variant) As Variant
Dim DzTmp(1 To 3) As Variant
For x = 1 To UBound(Dz) - 1
    For y = x + 1 To UBound(Dz)
        If Dz(x, 3) < Dz(y, 3) Then
            DzTmp(1) = Dz(x, 1)
            DzTmp(2) = Dz(x, 2)
            DzTmp(3) = Dz(x, 3)
            
            Dz(x, 1) = Dz(y, 1)
            Dz(x, 2) = Dz(y, 2)
            Dz(x, 3) = Dz(y, 3)
            
            Dz(y, 1) = DzTmp(1)
            Dz(y, 2) = DzTmp(2)
            Dz(y, 3) = DzTmp(3)
        ElseIf Dz(x, 3) = Dz(y, 3) Then
            If Dz(x, 1) > Dz(y, 1) Then
                DzTmp(1) = Dz(x, 1)
                DzTmp(2) = Dz(x, 2)
                DzTmp(3) = Dz(x, 3)
                
                Dz(x, 1) = Dz(y, 1)
                Dz(x, 2) = Dz(y, 2)
                Dz(x, 3) = Dz(y, 3)
                
                Dz(y, 1) = DzTmp(1)
                Dz(y, 2) = DzTmp(2)
                Dz(y, 3) = DzTmp(3)
            End If
        End If
    Next y
Next x

For x = 2 To UBound(Dz)
If Dz(x, 3) <> Dz(x - 1, 3) Then xSay = xSay + 1
If xSay = 3 Then xSon = x - 1
Next x

ReDim Tmp(1 To xSon, 1 To 3)
For x = 1 To xSon
    Tmp(x, 1) = Dz(x, 1)
    Tmp(x, 2) = Dz(x, 2)
    Tmp(x, 3) = Dz(x, 3)
Next x
DiziSirala = Tmp
End Function

odevci · 24 Ara 2023

@halily hocam çok teşekkür ederim.
Makro kodları sorunsuz çalıştı. Fonksiyonu nasıl çalıştırmalıyım? DEĞER hatası verdi.

halily · 24 Ara 2023

KTF olarak aşağıdaki kod kullanılabilir
Not: az önce belirtmeyi unutmuşum aralık seçerken başlıklar da seçilmeli

Kod:

=SiralaKTF(A1:E10)

gibi

VBA:

Function SiralaKTF(Rng As Range) As Variant

Dim DzTmp As Variant
Dim DzAna As Variant

DzTmp = Rng.Value2
ReDim DzAna(1 To (UBound(DzTmp) - 1) * 4, 1 To 3)

    For xStr = 2 To UBound(DzTmp)
        For yStn = 2 To 5
        t = t + 1
            DzAna(t, 1) = DzTmp(xStr, 1)
            DzAna(t, 2) = DzTmp(1, yStn)
            DzAna(t, 3) = DzTmp(xStr, yStn)
        Next yStn
    Next xStr

ReDim DzTmp(1 To 3)
For x = 1 To UBound(DzAna) - 1
    For y = x + 1 To UBound(DzAna)
        If DzAna(x, 3) < DzAna(y, 3) Then
            DzTmp(1) = DzAna(x, 1)
            DzTmp(2) = DzAna(x, 2)
            DzTmp(3) = DzAna(x, 3)
          
            DzAna(x, 1) = DzAna(y, 1)
            DzAna(x, 2) = DzAna(y, 2)
            DzAna(x, 3) = DzAna(y, 3)
          
            DzAna(y, 1) = DzTmp(1)
            DzAna(y, 2) = DzTmp(2)
            DzAna(y, 3) = DzTmp(3)
        ElseIf DzAna(x, 3) = DzAna(y, 3) Then
            If DzAna(x, 1) > DzAna(y, 1) Then
                DzTmp(1) = DzAna(x, 1)
                DzTmp(2) = DzAna(x, 2)
                DzTmp(3) = DzAna(x, 3)
              
                DzAna(x, 1) = DzAna(y, 1)
                DzAna(x, 2) = DzAna(y, 2)
                DzAna(x, 3) = DzAna(y, 3)
              
                DzAna(y, 1) = DzTmp(1)
                DzAna(y, 2) = DzTmp(2)
                DzAna(y, 3) = DzTmp(3)
            End If
        End If
    Next y
Next x

For x = 2 To UBound(DzAna)
If DzAna(x, 3) <> DzAna(x - 1, 3) Then xSay = xSay + 1
If xSay = 3 Then xSon = x - 1
Next x

ReDim Tmp(1 To xSon, 1 To 3)
For x = 1 To xSon
    Tmp(x, 1) = DzAna(x, 1)
    Tmp(x, 2) = DzAna(x, 2)
    Tmp(x, 3) = DzAna(x, 3)
Next x
SiralaKTF = Tmp
End Function

iyi çalışmalar)

cesur · 24 Ara 2023

Halil hocama alternatif olsun.
Kullanımı
=eniyiler(A1:E10)

Ömer BARAN · 24 Ara 2023

KTF alternatifi.

Formül kullanımı : =EN_IYILER(A1:E10;3)

VBA:

Function EN_IYILER(alan As Range, adet As Integer)
s = 1: kontrol = True: ReDim snc(1 To 4, 1 To s)
For b = 1 To adet
    If s = 1 Then: eksi = 1: Else: eksi = 2
    buyuk = Application.Large(alan, b + s - eksi)
    For a = 2 To alan.Rows.Count
        For u = 2 To alan.Columns.Count
            If Application.Index(alan, a, u) = buyuk Then
                s = s + 1: ReDim Preserve snc(1 To 4, 1 To s)
                snc(1, s) = Application.Index(alan, a, 1)
                snc(2, s) = Application.Index(alan, 1, u)
                snc(3, s) = buyuk: snc(4, s) = b & snc(1, s)
            End If
        Next
    Next
Next
snc(1, 1) = "Öğrenci": snc(2, 1) = "Ders": snc(3, 1) = "Not"
snc = Application.Transpose(snc)
Do While kontrol
    kontrol = False
    For byk = 2 To UBound(snc) - 1
        If snc(byk, 4) > snc(byk + 1, 4) Then
            ReDim gecici(1 To UBound(snc, 2), 1 To UBound(snc))
            For u = 1 To UBound(gecici)
                gecici(1, u) = snc(byk, u)
                snc(byk, u) = snc(byk + 1, u)
                snc(byk + 1, u) = gecici(1, u)
            Next: kontrol = True: Exit For
        End If
    Next
Loop
ReDim Preserve snc(1 To UBound(snc), 1 To UBound(snc, 2) - 1)
EN_IYILER = snc
End Function

odevci · 24 Ara 2023

@cesur hocam, @Ömer BARAN hocam çok teşekkürler. Bir istedik, bin verdiniz resmen. Öğrencilere bu kodları ders olarak okutacağım.

odevci · 24 Ara 2023

@cesur hocam,

Öğrenci	Ders	Not
Cezmi	Kimya	93
Siyami	Fizik	93
Siyami	Matematik	93
Lemi	Türkçe	90
Cafer	Kimya	89
Cezmi	Türkçe	89

Sıralama bu şekilde olmalıydı. Acaba buna göre revize etmeniz mümkün olabilir mi?

Çok teşekkürler.

halily · 24 Ara 2023

@Ömer BARAN ve @cesur hocalarımdan kopya çekip KTF kodunu güncelledim

Kod:

=SiralaKTF(A1:E10;3)

VBA:

Function SiralaKTF(Rng As Range, IlkSira As Integer) As Variant

Dim DzTmp As Variant
Dim DzAna As Variant

Dim xStnSay As Integer

DzTmp = Rng.Value2
xStnSay = UBound(DzTmp, 2) - 1
ReDim DzAna(1 To (UBound(DzTmp) - 1) * xStnSay, 1 To 3)

    For xStr = 2 To UBound(DzTmp)
        For yStn = 2 To xStnSay + 1
        t = t + 1
            DzAna(t, 1) = DzTmp(xStr, 1)
            DzAna(t, 2) = DzTmp(1, yStn)
            DzAna(t, 3) = DzTmp(xStr, yStn)
        Next yStn
    Next xStr

ReDim DzTmp(1 To 3)
For x = 1 To UBound(DzAna) - 1
    For y = x + 1 To UBound(DzAna)
        If DzAna(x, 3) < DzAna(y, 3) Then
            DzTmp(1) = DzAna(x, 1)
            DzTmp(2) = DzAna(x, 2)
            DzTmp(3) = DzAna(x, 3)
         
            DzAna(x, 1) = DzAna(y, 1)
            DzAna(x, 2) = DzAna(y, 2)
            DzAna(x, 3) = DzAna(y, 3)
         
            DzAna(y, 1) = DzTmp(1)
            DzAna(y, 2) = DzTmp(2)
            DzAna(y, 3) = DzTmp(3)
        ElseIf DzAna(x, 3) = DzAna(y, 3) Then
            If DzAna(x, 1) > DzAna(y, 1) Then
                DzTmp(1) = DzAna(x, 1)
                DzTmp(2) = DzAna(x, 2)
                DzTmp(3) = DzAna(x, 3)
             
                DzAna(x, 1) = DzAna(y, 1)
                DzAna(x, 2) = DzAna(y, 2)
                DzAna(x, 3) = DzAna(y, 3)
             
                DzAna(y, 1) = DzTmp(1)
                DzAna(y, 2) = DzTmp(2)
                DzAna(y, 3) = DzTmp(3)
            End If
        End If
    Next y
Next x

For x = 2 To UBound(DzAna)
    If DzAna(x, 3) <> DzAna(x - 1, 3) Then xSay = xSay + 1
    If xSay = IlkSira Then xSon = x - 1: Exit For
Next x

ReDim Tmp(1 To xSon, 1 To 3)
For x = 1 To xSon
    Tmp(x, 1) = DzAna(x, 1)
    Tmp(x, 2) = DzAna(x, 2)
    Tmp(x, 3) = DzAna(x, 3)
Next x
SiralaKTF = Tmp
End Function

ExcelDepo · 24 Ara 2023

Biraz uzun sürdü ama Excel 365 ile iyi bir formül ortaya çıktı diye düşünüyorum.

Kod:

=LET(o;A2:A10;d;B1:E1;n;B2:E10;a;SIRALA(YATAYYIĞ(SÜTUNA(EĞERYOKSA(o;d));SÜTUNA(EĞERYOKSA(d;o));SÜTUNA(n));{3;1;2};{-1;1;1});b;BÜYÜK(BENZERSİZ(SÜTUNSEÇ(METİNBÖL(METİNBİRLEŞTİR("*";1;o&"-"&d&"-"&n);"-";"*");3)*1);3);FİLTRE(a;İNDİS(a;;3)>=b))

ExcelDepo · 24 Ara 2023

Bir tık daha kısa versiyonu olarak bunu da ekleyelim.

Kod:

=LET(o;A2:A10;d;B1:E1;n;B2:E10;m;SÜTUNA(n);SIRALA(FİLTRE(YATAYYIĞ(SÜTUNA(EĞER(n;o));SÜTUNA(EĞER(n;d));m);m>BÜYÜK(BENZERSİZ(m);4));{3;1};{-1;1}))

odevci · 24 Ara 2023

Hocalarım vallahi hangi birini kullanacağımı şaşırdım. Çok teşekkür ederim hepinizi.