Birebir Ders Takip Programı

[meyill]

Merhaba değerli arkadaşlar, Bir deshaneye ait öğrenci Birebir ders takip programı oluşturmak istiyorum. Genel bilgilerini Öğrenci Takip Kartına istenen şekilde aktaracak makroya ihtiyacım var. Verilerin bir kaçı ekteki örnektedir.
Yardımlarınız için teşekkürler..

 

[Muhammet Okumuş]

Merhaba,
Dosyayı inceleyiniz.

Sub Aktar()
Range("D:ZZ") = ""
Application.ScreenUpdating = False
Set G = Sheets("Genel Bil")
son = G.Cells(Rows.Count, "D").End(3).Row
For i = 2 To son
sat = WorksheetFunction.Match(G.Cells(i, 4), Range("B1:B1000"), 0)
sut = WorksheetFunction.CountA(Range(Cells(sat, 4), Cells(sat, 1000))) + 4
Cells(sat, sut) = G.Cells(i, 5).Value
Cells(sat + 1, sut) = G.Cells(i, 2).Value
Cells(sat + 2, sut) = G.Cells(i, 3).Value
Next
End Sub

 

[meyill]

Yardımlarınız için teşekkürler..

 

[hakantb]

Merhaba,
Dosyayı inceleyiniz.

Mehmet Okumuş kodun açıklamasını yazabilirmisiniz
örnek olarak
Range("D:ZZ") = "" 'D sütunundan ZZ sütununa kadar sil

 

[Muhammet Okumuş]

Sub Aktar()
Range("D:ZZ") = ""
Application.ScreenUpdating = False -- İşlem yapılırken ekrana yansıtma, işlem bittiğinde gösterir.
Set G = Sheets("Genel Bil") -- Sayfa adını kısaltmak için tanımlama yaptık
son = G.Cells(Rows.Count, "D").End(3).Row -- Genel Bil sayfasına en alttaki veri satırını buluyoruz.
For i = 2 To son -- Yapılcak işlemleri döngüye aldık.
sat = WorksheetFunction.Match(G.Cells(i, 4), Range("B1:B1000"), 0) -- cells(i,4) öğrenci adını ifade ediyor. Kaçıncı formülü ile öğrencinin çizelgede kaçıncı satırda olduğunu buluyoruz.
sut = WorksheetFunction.CountA(Range(Cells(sat, 4), Cells(sat, 1000))) + 4 -- sat ifadesi ile bulduğumuz satırın, ne kadar veri içerdiğini buluyoruz. 4. sütundan başlatmak için +4 ile topluyoruz.
Cells(sat, sut) = G.Cells(i, 5).Value -- sat ve sut değerinin kesiştiği yere ders adı. cells(i,5) ders adıdır.
Cells(sat + 1, sut) = G.Cells(i, 2).Value
Cells(sat + 2, sut) = G.Cells(i, 3).Value
Next
End Sub

Bu şekil dosya hazırlandı

 

[meyill]

Burada bir olayı daha gerçekleştirmesini istiyorum. "Genel bil" sayfasındaki öğrenci isimlerinide makro aktarsın. Bunun için bir kod yazılırsa sevinirim. Çünkü asıl listem kabarık öğrencilerin isimlerini yazmak çok zaman alıyor.

 

[Muhammet Okumuş]

Merhaba,
Şablon sayfasında yapacağınız değişikler Takip sayfasına aynen aktarılıyor.

Sub Aktar()
Application.ScreenUpdating = False
Range("B:ZZ") = ""
Range("B:ZZ").UnMerge
Range("B:ZZ").Borders.LineStyle = 0

Set G = Sheets("Genel Bil")
son = G.Cells(Rows.Count, "D").End(3).Row
For i = 2 To son
If WorksheetFunction.CountIf(Range("C1:C1000"), G.Cells(i, 4)) = 0 Then
son = Range("B1000").End(3).Row + 3
Sheets("Şablon").Range("B1:L4").Copy Range("B" & son)
Range("C" & son + 1) = G.Cells(i, 4).Value
Range("B" & son + 1) = WorksheetFunction.Max(Range("B1:B1000")) + 1
End If
sat = WorksheetFunction.Match(G.Cells(i, 4), Range("C1:C1000"), 0)
sut = WorksheetFunction.CountA(Range(Cells(sat, 5), Cells(sat, 1000))) + 5
Cells(sat, sut) = G.Cells(i, 5).Value
Cells(sat + 1, sut) = G.Cells(i, 2).Value
Cells(sat + 2, sut) = G.Cells(i, 3).Value
Next
Set G = Nothing
End Sub

 

[hakantb]

Çok Teşekkür Ederim mehmet Okumuş

 

[meyill]

Bunu office 2003 'te denediğimde hata verdi. Hata
sut = WorksheetFunction.CountA(Range(Cells(sat, 5), Cells(sat, 1000))) + 5
satırı gösteriyor. 2007'de sorunsuz çalışıyor. fark neden kaynaklanıyor. Yada 2003 e nasıl uyarlanabilir?

 

[Muhammet Okumuş]

Sorunuza cevap verildiği zaman geri dönüşte bulununuz.

sut = WorksheetFunction.CountA(Range(Cells(sat, 5), Cells(sat, 1000))) + 5

Excel 2003'te en fazla 255 sütun vardır. 1000 yazan yeri 255 yapınız.

 

[meyill]

Elinize sağlık teşekkürler..