Osym istatistik

[wezyr]

ilçem okulların osym istatistiki verilerini tutmak istiyor. kkisten alına verilerin analizini yapmamı istediler. problemim kkisteki verilerin isttedeğimiz düzende gelmemesi nedeniyle ilgli analiz yapmakta güçlük çekiyoruz. hazırlayacağımız bir şblonla bu işi hızlandırmak istiyoruz. yadımcı olursanız sevinirim örnek dosyamız ektedir. ilgilenecek arkadaşlara şimdiden teşekkür ederim.

Öğrenci sayısı okuldan okula değişebilmekte en kalabalık olan okulumuzun 1200 öğrencisi bulunmakta. Bu şekilde öğrenci netleri ve puanlarını analiz etmek istiyoruz ama bu haliyle analiz etmemiz zor olacak. Bu nedenle sistemden kopyaladığımız verileri verinet ve veripuan sayfalarına yapıştırarak nasıl ilgili sayfalara aktara biliriz. verinetteki veriler Net sayfasına , veripuan sayfasındaki veriler Puan sayfasına aktarılacak. öğrenci tc kimlik nolarını almaya gerek yok. Ayrıca aktarma işlemini yaptıktan sonra Puan ve Net sayfalarını Yeni bir excel dosyası olarak (dosya adı kurum kodu olacak şekilde) kayıt ederek belirli bir eposta adresine yollanmasını sağlayabilirmiyiz.makro yada formülle yardımcı olacaklara şimden teşekkürler.

 

[ÖmerBey]

Merhaba,
eposta hariç aşağıdaki kodu deneyiniz.

Sub KOD()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set vn = Sheets("verinet")
Set n = Sheets("Net")
Set vp = Sheets("veripuan")
Set p = Sheets("Puan")
n.Range("A4:U65000").ClearContents
p.Range("A4:R65000").ClearContents
x = 4
y = 4
For a = 6 To vn.Range("A65500").End(3).Row Step 7
    n.Cells(x, "A") = vn.Range("D1")
    n.Cells(x, "B") = vn.Range("D2")
    n.Cells(x, "C") = vn.Range("D3")
    n.Cells(x, "D") = vn.Cells(a, "A")
    n.Cells(x, "E") = vn.Cells(a, "B")
    n.Cells(x, "F") = vn.Cells(a + 3, "D")
    n.Cells(x, "G") = vn.Cells(a + 4, "D")
    n.Cells(x, "H") = vn.Cells(a + 5, "D")
    n.Cells(x, "I") = 1 * Split(vn.Cells(a + 6, "D"), ":")(1)
    n.Cells(x, "J") = vn.Cells(a + 3, "E")
    n.Cells(x, "K") = vn.Cells(a + 4, "E")
    n.Cells(x, "L") = vn.Cells(a + 5, "E")
    n.Cells(x, "M") = 1 * Split(vn.Cells(a + 6, "E"), ":")(1)
    n.Cells(x, "N") = vn.Cells(a + 3, "F")
    n.Cells(x, "O") = vn.Cells(a + 4, "F")
    n.Cells(x, "P") = vn.Cells(a + 5, "F")
    n.Cells(x, "Q") = 1 * Split(vn.Cells(a + 6, "F"), ":")(1)
    n.Cells(x, "R") = vn.Cells(a + 3, "G")
    n.Cells(x, "S") = vn.Cells(a + 4, "G")
    n.Cells(x, "T") = vn.Cells(a + 5, "G")
    n.Cells(x, "U") = 1 * Split(vn.Cells(a + 6, "G"), ":")(1)
    x = x + 1
Next

For b = 6 To vp.Range("A65500").End(3).Row Step 2
    p.Cells(y, "A") = vp.Range("D1")
    p.Cells(y, "B") = vp.Range("D2")
    p.Cells(y, "C") = vp.Range("D3")
    p.Cells(y, "D") = vp.Cells(b, "A")
    p.Cells(y, "E") = vp.Cells(b, "B")
    p.Cells(y, "F") = vp.Cells(b, "C")
    p.Cells(y, "G") = 1 * Split(vp.Cells(b, "D"), ":")(1)
    p.Cells(y, "H") = 1 * Split(vp.Cells(b + 1, "D"), ":")(1)
    p.Cells(y, "I") = 1 * Split(vp.Cells(b, "E"), ":")(1)
    p.Cells(y, "J") = 1 * Split(vp.Cells(b + 1, "E"), ":")(1)
    p.Cells(y, "K") = 1 * Split(vp.Cells(b, "F"), ":")(1)
    p.Cells(y, "L") = 1 * Split(vp.Cells(b + 1, "F"), ":")(1)
    p.Cells(y, "M") = 1 * Split(vp.Cells(b, "G"), ":")(1)
    p.Cells(y, "N") = 1 * Split(vp.Cells(b + 1, "G"), ":")(1)
    p.Cells(y, "O") = 1 * Split(vp.Cells(b, "H"), ":")(1)
    p.Cells(y, "P") = 1 * Split(vp.Cells(b + 1, "H"), ":")(1)
    p.Cells(y, "Q") = 1 * Split(vp.Cells(b, "I"), ":")(1)
    p.Cells(y, "R") = 1 * Split(vp.Cells(b + 1, "I"), ":")(1)
    y = y + 1
Next

dosyaadı = vn.Range("D2")
Sheets(Array("Net", "Puan")).Copy
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & dosyaadı & ".xlsx"
ActiveWorkbook.Close 0
MsgBox "Dosyanız " & ThisWorkbook.Path & " konumuna, " & dosyaadı & ".xlsx" & " ismiyle kaydedilmiştir."

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = False
End Sub

 

[wezyr]

teşekkürler elinize sağlık