alınan notlara göre listelemek

[Muhammet Okumuş]

arkadaşlar öğrencilerin aldıkları notlara göre sıralamak istiyorum.notlar mükerrer olmayacak.notları alanlar notun yanındaki sütunlara yazılacak

 

[Necdet]

Merhaba,

Makrolu çözüm isterseniz

Sub Macro1()
Dim i As Long
i = [B65536].End(3).Row
Range("D:D").ClearContents
Range("B1:B" & i).AdvancedFilter Action:=xlFilterCopy, _
                                 CopyToRange:=Range("D1"), _
                                 Unique:=True
i = [D65536].End(3).Row
Range("D2:D" & i).Sort Key1:=[D2]
End Sub

 

[Muhammet Okumuş]

necdet hocam teşekkür edrim.olmuş ama ben bir de notları kimin aldığını istemiştim.örneğin 15 alanlar diğer sütunlarda listelencek

 

[Necdet]

hmm, hemen taktik değiştirmek gerek o zaman

Sub Macro1()
Dim i As Long
i = [B65536].End(3).Row
Range("D:IV").ClearContents
Range("B1:B" & i).AdvancedFilter Action:=xlFilterCopy, _
                                 CopyToRange:=Range("D1"), _
                                 Unique:=True
i = [D65536].End(3).Row
Range("D2:D" & i).Sort Key1:=[D2]
For i = 2 To [D65536].End(3).Row
    Kolon = 4
    With Range("B2:B" & [B65536].End(3).Row)
        Set Bul = .Find(Cells(i, "D"), LookIn:=xlValues, LookAt:=xlWhole)
        If Not Bul Is Nothing Then
            Adres1 = Bul.Address
            Do
                Set Bul = .FindNext(Bul)
                Kolon = Kolon + 1
                Cells(i, Kolon) = Cells(Bul.Row, "A")
            Loop While Not Bul Is Nothing And Bul.Address <> Adres1
        End If
    End With
Next i
End Sub

 

[Muhammet Okumuş]

tamam Necdet Bey bu kez olmuş.Çok teşekkür ederim...