ders listeleme

[zerali]

arkadaşlar benim bu proğramda yapmak istediğim şey ing,mat,bilim vb. seçen tüm öğrencileri sıralayabilmek ve listesini çıkarabilmek (ders adı önemli yanındaki rakamlar önemli değil) şimdiden teşekkürler.

 

[Muhammet Okumuş]

Merhaba,
Kodu deneyiniz.

Sub Listele()
Application.ScreenUpdating = False

For a = 1 To 3
Sheets(a).Select
Range("I:BI") = ""
son = Cells(Rows.Count, 4).End(3).Row
For i = 1 To 10
Range("E1:G" & son).Replace i - 1, ""
Next

For i = 1 To son
For j = 5 To 7
adet = WorksheetFunction.CountIf(Range("I1:BI1"), Cells(i, j))
If adet = 0 Then
süt = WorksheetFunction.CountA(Range("I1:BI1")) + 9
Cells(1, süt) = Cells(i, j).Value
Cells(2, süt) = Cells(i, 4).Value
GoTo 10
End If
süt = WorksheetFunction.Match(Cells(i, j), Range("I1:BI1"), 0) + 8
sat = Cells(Rows.Count, süt).End(3).Row + 1
Cells(sat, süt) = Cells(i, 4).Value
10
Next
Next
Next
End Sub

 

[zerali]

Muhammet okumuş hocam bu kodu nereye nasıl uygulayacağım

 

[Muhammet Okumuş]

Resimleri inceleyiniz.

 

[Muhammet Okumuş]

3. resimde Modul içine kodları yapıştırın.

 

[zerali]

Muhammet okumuş hocam çok teşekkürler sayenizde yeni bir şey daha öğrendim çok sağolun

 

[Muhammet Okumuş]

Şeride Düğme (Form Denetimi) eklerseniz dosyanıza kodu daha çabuk uygularsınız.

 

[zerali]

Muhammet okumuş hocam sizi biraz yordum ama, son bir şey farkettim ben bunları e okula atacağım için bana sınıf ve numaralarıda lazım olacak aktarırken sınıf ve numaralarıda aktarma imkanı olabilir mi acaba

 

[Muhammet Okumuş]

Hocam kodu deneyiniz. Olmazsa 1 tane şablon sayfası oluşturup o şablon dosyanın içine atmasını da sağlayabiliriz.

Sub Listele()
Application.ScreenUpdating = False

For a = 1 To 3
Sheets(a).Select
Range("I:HI") = ""
son = Cells(Rows.Count, 4).End(3).Row
For i = 1 To 10
Range("E1:G" & son).Replace i - 1, ""
Next

For i = 1 To son
For j = 5 To 7
adet = WorksheetFunction.CountIf(Range("I1:HI1"), Cells(i, j))
If adet = 0 Then
süt = WorksheetFunction.CountA(Range("I1:HI1")) * 4 + 9
Cells(1, süt) = Cells(i, j).Value
Cells(2, süt) = Cells(i, 2).Value
Cells(2, süt + 1) = Cells(i, 3).Value
Cells(2, süt + 2) = Cells(i, 4).Value
GoTo 10
End If
süt = WorksheetFunction.Match(Cells(i, j), Range("I1:HI1"), 0) + 8
sat = Cells(Rows.Count, süt).End(3).Row + 1
Cells(sat, süt) = Cells(i, 2).Value
Cells(sat, süt + 1) = Cells(i, 3).Value
Cells(sat, süt + 2) = Cells(i, 4).Value
10
Next
Next
Next
End Sub

 

[zerali]

oldu hocam çok teşekkürler çok sağolun

 

[Muhammet Okumuş]

Rica ederim. İyi çalışmalar.