Okul Sınav Değerlendirme Projesi Yardım lütfen !

Probilgi · 13 Nisan 2008

Arkadaşlar bir okul projesi için yardımınıza ihtiyacım var, eğer bu düşüncem gerçekleşirse çok büyük bir iş ve zaman kaybını önlemiş olacağım.

EK'te düzenlemiş olduğum projemde HESAPLAMA, VERI ve SIRALAMA sekmeleri yeralmaktadır.

HESAPLAMA bölümünde öğrencinin Netleri, doğruları, yanlışlarının varolduğu bir karne düzenlemesi var. Veri bölümünden öğrenci yanıtlarını çekerek hesaplamaları yaptırdım.

VERI bölümünde optik okuyucudan almış olduğu veriyi DATA/SINAV-44152.txt dosyasından çeken bir düzenleme var. Sınav-Degerlendirmesi.xls yi ilk açtığımızda Otomatik yenilemeyi aktif et seçeneğini seçerek DATA içindeki dosyayı tanıtıyoruz.

SIRALAMA bölümünde VERI bölümündeki bütün öğrencilerin hesaplamaları yapıldıktan sonra Okul sıralamaları yapılması gerekiyor.

HESAPLAMA bölümünde 1 kişinin istediğim gibi herşeyini hesaplattırıyorum fakat Sınava bir anda 800 öğrenci girdiği zaman veri bölümünde 800 veri oluşacak bu işin içinden nasıl çıkarım. Bu projem için yardımlarınızı, fikir ve tüyolarınızı bekliyorum arkadaşlar. . .

Şu yöntem şu işe yarar, şununla sonuca ulaşabilir şunu uygularsan işin içinden çıkabilirsin tarzı yorumlarınızıda bekliyorum

Teşekürler Saygılar. . .

Ferhat Pazarçevirdi · 13 Nisan 2008

Ekteki, örneği inceleyiniz.

ÖNEMLİ : Önce, "txt" dosyadan verilerinizi güncelleyiniz.

Hesaplama sayfasındaki açılan listeden bir öğrenci seçiniz ve sonucu görünüz. Yanlışlık varsa bildiriniz.

Sıralama sayfasına geçtiğiniz anda tüm veriler derlenerek, sayfaya listelenir. İnceleyiniz ve yanlışlık varsa bildiriniz.

Bu işlemler için; aşağıdaki kodlar kullanıldı.

Standart bir modül sayfası oluşturuldu (fpc01) ve kodlar eklendi.

Kod:

Option Explicit
Sub Ogrenci_Listesi()
    Dim arrCA(1 To 240) 'Cevap Anahtar&#305;ndaki veriler
    Dim arrSV() 'S&#305;nav Sonu&#231;lar&#305;
    Dim arrNET()
    Dim arrPU()
    Dim shH As Worksheet
    Dim shV As Worksheet
    Dim shS As Worksheet
    Dim dogru&#37;, yanlis%, bos%
    Dim i%, j%, y%, x%, z%, satir%, deger%, k%
    Set shH = Sheets("HESAPLAMA")
    Set shV = Sheets("VERI")
    Set shS = Sheets("SIRALAMA")
 
    satir = shS.Cells(65536, 2).End(xlUp).Row + 1
    shS.Range("B6:K" & satir).ClearContents
 
 
    'Cevap Anahtar&#305;n&#305;n Sayfadan &#231;ekilmesi
    For j = 31 To 52 Step 3
        For i = 22 To 51
            x = x + 1
            arrCA(x) = shH.Cells(i, j)
        Next i
    Next j
 
 
    For i = 4 To shV.Cells(65536, 2).End(xlUp).Row
 
        ReDim arrSV(1 To 240)
        ReDim arrNET(1 To 8, 1 To 4)
 
        'Bir &#214;&#287;renci i&#231;in Cevaplar&#305;n diziye al&#305;nmas&#305;
        y = 0
        For j = 7 To 246
            y = y + 1
            arrSV(y) = shV.Cells(i, j)
        Next j
 
 
        For x = 1 To 240
            'S&#305;nav B&#246;l&#252;mlerinin ayr&#305;m&#305; -> T&#220;RK&#199;E, SOS-1, MAT-1 ....
            Select Case x
                Case 1 To 30: z = 1
                Case 31 To 60: z = 2
                Case 61 To 90: z = 3
                Case 91 To 120: z = 4
                Case 121 To 150: z = 5
                Case 151 To 180: z = 6
                Case 181 To 210: z = 7
                Case 211 To 240: z = 8
            End Select
 
            'B&#246;l&#252;m ba&#351;lar&#305;nda dogru, yanlis ve bos saya&#231;lar&#305;n&#305;n s&#305;f&#305;rlanmas&#305; ...
            If x = 1 Or x = 31 Or x = 61 Or x = 91 Or x = 121 Or x = 151 Or x = 181 Or x = 211 Then
                dogru = 0: yanlis = 0: bos = 0
            End If
 
            'dogru, yanlis ve bos saya&#231;lar&#305;na de&#287;er y&#252;klenmesi
            If arrCA(x) = arrSV(x) Then
                dogru = dogru + 1: yanlis = yanlis: bos = bos
            ElseIf arrSV(x) = Empty Then
                dogru = dogru: yanlis = yanlis: bos = bos + 1
            Else
                dogru = dogru: yanlis = yanlis + 1: bos = bos
            End If
 
            'B&#246;l&#252;mlere g&#246;re dogru, yanlis, bos ve netlerin diziye al&#305;nmas&#305;
            arrNET(z, 1) = dogru
            arrNET(z, 2) = yanlis
            arrNET(z, 3) = bos
            arrNET(z, 4) = dogru - (yanlis / 4)
        Next x
        'Puanlamalar&#305;n diziye al&#305;nmas&#305; (SAY-1, SAY-2, EA-1 -> ...)
        ReDim arrPU(1 To 6)
 
        arrPU(1) = (arrNET(1, 4) * 0.81) + (arrNET(2, 4) * 0.576) + (arrNET(3, 4) * 2.4) + (arrNET(4, 4) * 2.043) + 125.13
        arrPU(2) = (arrNET(1, 4) * 0.812) + (arrNET(2, 4) * 0.578) + (arrNET(3, 4) * 1.202) + (arrNET(4, 4) * 1.024) + (arrNET(7, 4) * 1.337) + (arrNET(8, 4) * 1.098) + 118.47
        arrPU(3) = (arrNET(1, 4) * 2.246) + (arrNET(2, 4) * 0.898) + (arrNET(3, 4) * 2.246) + (arrNET(4, 4) * 0.607) + 120.09
        arrPU(4) = (arrNET(1, 4) * 1.103) + (arrNET(2, 4) * 0.882) + (arrNET(3, 4) * 1.103) + (arrNET(4, 4) * 0.596) + (arrNET(5, 4) * 1.317) + (arrNET(7, 4) * 1.225) + 113.22
        arrPU(5) = (arrNET(1, 4) * 2.654) + (arrNET(2, 4) * 1.982) + (arrNET(3, 4) * 0.707) + (arrNET(4, 4) * 0.574) + 122.49
        arrPU(6) = (arrNET(1, 4) * 1.211) + (arrNET(2, 4) * 0.904) + (arrNET(3, 4) * 0.646) + (arrNET(4, 4) * 0.523) + (arrNET(5, 4) * 1.445) + (arrNET(6, 4) * 1.28) + 119.73
 
 
'        Set shS = Sheets("SIRALAMA")
        satir = shS.Cells(65536, 2).End(xlUp).Row + 1
        shS.Cells(satir, 3) = Application.WorksheetFunction.Proper(shV.Cells(i, 6))
        shS.Cells(satir, 2) = shV.Cells(i, 2)
 
        deger = 0: For k = 1 To UBound(arrNET): deger = deger + arrNET(k, 1): Next
        shS.Cells(satir, 4) = deger
        deger = 0: For k = 1 To UBound(arrNET): deger = deger + arrNET(k, 2): Next
        shS.Cells(satir, 5) = deger
 
        shS.Cells(satir, 6) = arrPU(1)
        shS.Cells(satir, 7) = arrPU(2)
        shS.Cells(satir, 8) = arrPU(3)
        shS.Cells(satir, 9) = arrPU(4)
        shS.Cells(satir, 10) = arrPU(5)
        shS.Cells(satir, 11) = arrPU(6)
 
    Next i
 
    Set shH = Nothing
    Set shV = Nothing
    Set shS = Nothing
End Sub
 
Sub Tek_Ogrencinin_Bilgileri()
    Dim arrCA(1 To 240) 'Cevap Anahtar&#305;ndaki veriler
    Dim arrSV() 'S&#305;nav Sonu&#231;lar&#305;
    Dim arrNET()
    Dim arrPU()
    Dim shH As Worksheet
    Dim shV As Worksheet
    Dim shS As Worksheet
    Dim dogru%, yanlis%, bos%
    Dim j%, i%, x%, y%, z%, d%, c%, sat%, sutun%
    Dim bul As Range
    Set shH = Sheets("HESAPLAMA")
    Set shV = Sheets("VERI")
 
    'Cevap Anahtar&#305;n&#305;n Sayfadan &#231;ekilmesi
    For j = 31 To 52 Step 3
        For i = 22 To 51
            x = x + 1
            arrCA(x) = shH.Cells(i, j)
        Next i
    Next j
 
 
    Set bul = shV.Columns(6).Find(shH.Cells(10, "K"), Lookat:=xlWhole)
    If Not bul Is Nothing Then
        i = bul.Row
    Else
        MsgBox "Bu isimde &#246;&#287;renci bulunamad&#305;", vbCritical, "UYARI"
        Exit Sub
    End If
'    For i = 4 To shV.Cells(65536, 2).End(xlUp).Row
 
        ReDim arrSV(1 To 240)
        ReDim arrNET(1 To 8, 1 To 4)
 
        'Bir &#214;&#287;renci i&#231;in Cevaplar&#305;n diziye al&#305;nmas&#305;
        y = 0
        For j = 7 To 246
            y = y + 1
            arrSV(y) = shV.Cells(i, j)
        Next j
 
'For o = 1 To 240
'    Cells(o, 1) = arrCA(o)
'    Cells(o, 2) = arrSV(o)
'Next o
 
 
        For x = 1 To 240
            'S&#305;nav B&#246;l&#252;mlerinin ayr&#305;m&#305; -> T&#220;RK&#199;E, SOS-1, MAT-1 ....
            Select Case x
                Case 1 To 30: z = 1
                Case 31 To 60: z = 2
                Case 61 To 90: z = 3
                Case 91 To 120: z = 4
                Case 121 To 150: z = 5
                Case 151 To 180: z = 6
                Case 181 To 210: z = 7
                Case 211 To 240: z = 8
            End Select
 
            'B&#246;l&#252;m ba&#351;lar&#305;nda dogru, yanlis ve bos saya&#231;lar&#305;n&#305;n s&#305;f&#305;rlanmas&#305; ...
            If x = 1 Or x = 31 Or x = 61 Or x = 91 Or x = 121 Or x = 151 Or x = 181 Or x = 211 Then
                dogru = 0: yanlis = 0: bos = 0
            End If
 
            'dogru, yanlis ve bos saya&#231;lar&#305;na de&#287;er y&#252;klenmesi
            If arrCA(x) = arrSV(x) Then
                dogru = dogru + 1: yanlis = yanlis: bos = bos
            ElseIf arrSV(x) = Empty Then
                dogru = dogru: yanlis = yanlis: bos = bos + 1
            Else
                dogru = dogru: yanlis = yanlis + 1: bos = bos
            End If
 
            'B&#246;l&#252;mlere g&#246;re dogru, yanlis, bos ve netlerin diziye al&#305;nmas&#305;
            arrNET(z, 1) = dogru
            arrNET(z, 2) = yanlis
            arrNET(z, 3) = bos
            arrNET(z, 4) = dogru - (yanlis / 4)
        Next x
 
        d = 26: c = 52
        For i = 1 To 8
            d = d + 3: c = c + 3
            shH.Cells(12, d) = arrNET(i, 4)
            shH.Cells(16, d) = arrNET(i, 3)
 
            shH.Cells(12, c) = arrNET(i, 1)
            shH.Cells(16, c) = arrNET(i, 2)
 
        Next i
 
        sat = 21
        sutun = 57
        For i = 1 To 240
            sat = sat + 1
            If sat = 52 Then: sat = 22: sutun = sutun + 3
            shH.Cells(sat, sutun) = arrSV(i)
        Next i
 
    Erase arrNET
    Erase arrSV
    Erase arrCA
    Set shH = Nothing
    Set shV = Nothing
    Set shS = Nothing
End Sub

"Hesaplama" sayfasına :

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [K10]) Is Nothing Then: Exit Sub
Call Tek_Ogrencinin_Bilgileri
End Sub

"Sıralama" sayfasına ise aşağıdakiler yazıldı.

Kod:

Private Sub Worksheet_Activate()
Call Ogrenci_Listesi
End Sub

Probilgi · 13 Nisan 2008

Ferhat Hocam elinize emeğinize sağlık tam istediğim gibi olmuş.

HESAPLAMA bölümünde ADI SOYADI kısmını tıkladığımda öğrencilerin isimlerinin olduğu bi çubuk açılıyor küçük olduğundan isimler gözükmüyor bunu büyüte bilme şansımız varmıdır ?

SIRALAMA bölümünde Veri/Sırala bölümü yardımıyla B6 ve K6 satırından 1000 satır aşağı doğru seçerek DOĞRU ve YANLIŞ ına göre Azalan olarak sıralıyorum, bunun makrosunu yaptım tam olarak nereye yerleştireyimki otomatiğe bağlansın ?

Birde Toplu karne çıktısı alınması mümkünse bu iş için 1 gün öğlenden geceye kadar uğraşan 8 personel ve 800 öğrenci ellerinizden öper

ÇOK ÇOK TEŞEKÜR EDERİM, SARF ETTİĞİN EMEĞE HELAL OLSUN

Ferhat Pazarçevirdi · 13 Nisan 2008

O zaman, revize edilmiş, ekteki dosyayı inceleyiniz.

Probilgi · 13 Nisan 2008

Hocam şu durumda tek gereksinim duyduğum (program yapıldıktan sonra herşey ortaya çıkıyor)
HESAPLAMA bölümündeki İsim Combobox u yerine Öğrenci Numarası aratması benim için daha iyi olur

çünkü isimlerini kodlamayan öğrenciler oluyor, Numarasından aratırım

BAŞKA SÖZE GEREK YOK SÜPERSİNİZ DİYORUM

Hayaldi -> Gerçek Oldu

Probilgi · 6 Mayıs 2008

Ferhat hocam,

VERI sekmesinde otomatik olarak txt dosyasını seçtiğimde öğrenci kodlamaları karşımıza geliyor, fakat burada öğrenciler isimlerini yanlış kodlayabiliyor. VERI sekmesinin hemen yanına ÖĞRENCİLER sekmesi ekledim. B sütununda numaraları C sütununda ise isimleri D sütununda soyadları bulunuyor. Bir eşleme ile VERI sekmesinde bulunan öğrencilerin Bozuk isimleri ile Normal isimlerini değiştirmesini sağlayabilirmiyiz

gertt · 22 Şubat 2010

linki yeniler misiniz?

freelion · 19 Mayıs 2010

teşekkür ederim....

Metin Karaağaç · 19 Mayıs 2010

Söz konusu dosya indirilemediği için kilitledim.
Ferhat Bey ya da Sn. Probilgi linki güncellerse konu tekrar mesaja açılabilir.

Okul Sınav Değerlendirme Projesi Yardım lütfen !

Probilgi

Ferhat Pazarçevirdi

Özel Üye

Probilgi

Ferhat Pazarçevirdi

Özel Üye

Probilgi

Probilgi

gertt

freelion

Metin Karaağaç

Uzman