[giúp] Tính điểm của học sinh (2 người xem)

  • Thread starter Thread starter vsxmm
  • Ngày gửi Ngày gửi
Liên hệ QC

Người dùng đang xem chủ đề này

vsxmm

Thành viên mới
Tham gia
22/10/11
Bài viết
31
Được thích
1
Hiện tại mình có vấn đề sau mong anh chị em giúp đỡ với. rất mong nhận được sự quan tâm
Mỗi lần kiểm tra cho học sinh mình tạo mẫu bên google form cho học sinh nộp lại đáp án. Sau đó mình tài xuống chấm bằng tay nhưng quá khổ. Mình muốn Chấm bằng máy tính cho đỡ khổ bớt. mình đã mô tả trong sheet LuuDA của File đính kèm. còn đây là mô tả nhanh qua.
Khi học sinh nộp đáp án mình tải về và copy vào sheet HsNop, Chạy code tính câu đúng so với đáp án ở sheet LuuDA, Sau đó ghi số điểm vào sheet LuuDiem.
Nếu có thể thì đáp án nào đúng thì đổi màu thành màu xanh da trời (hoặc xah nước biển) luôn giùm với.
Cảm on anh chị em trong diễn đàn.
 

File đính kèm

Nhờ anh chị em xem giúp với. Sao khi cho chạy 1 sub (hoặc xoaHS2lan - dùng để xóa các học sinh nộp nhiều lần của 1 mã đề; hoặc Tinhluudiem - dùng để tính điểm của học sinh) thi chajy binh thuong nhung khi chạy cả 2 sub thì máy tính bị đơ và khong chạy được.
mong anh chị em quan tâm với. cảm ơn nhiều
Đây là sub:
Mã:
Sub A_TinhdiemHSNopDA()
Dim ir_End As Integer
'--------lam cho code chay nhay va on dinh hon
    Application.Interactive = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False
'----------------------------------
ir_End = 1 '---------ir_End:Hang cuoi cua chua du lieu cua sheets("HSNop")
Do
    ir_End = ir_End + 1
Loop Until Sheets("HsNop").Cells(ir_End + 1, 3).Value = ""
'Call XoaHS2lan(2, ir_End, 3, 5)
Call Tinhluudiem
'--------mo khoa cho tac dong vao excel
    Application.Interactive = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
Sub XoaHS2lan(ir_Home, ir_End As Integer, ic_HS, ic_Mde As Byte)
Dim ir_Chay, ir_r As Integer
If ir_Home + 1 = ir_End Then
    Exit Sub
End If
'-------------------------------
ir_Chay = ir_Home
Do
    For ir_r = ir_Chay + 1 To ir_End
        Select Case Sheets("HsNop").Cells(ir_Chay, ic_HS).Value
        Case Sheets("HsNop").Cells(ir_r, ic_HS).Value
            If Sheets("HsNop").Cells(ir_Chay, ic_Mde).Value = Sheets("HsNop").Cells(ir_r, ic_Mde).Value Then
                Rows(ir_Chay).Select
                Selection.Delete Shift:=xlUp
                ir_Chay = ir_Chay - 1
                ir_r = ir_r - 1
                ir_End = ir_End - 1
            End If
        End Select
    Next ir_r
    ir_Chay = ir_Chay + 1
Loop Until ir_Chay = ir_End - 1
End Sub

Sub Tinhluudiem()
Dim iEnd_Nop, ir_Nop, iEnd_Luudiem, ir_Luudiem As Long
Dim iEnd_Made, iMade, iEnd_DA, ic_DA As Integer
Dim iMark As Variant
iEnd_Nop = Sheets("HsNop").Cells(2, 3).End(xlDown).Row
iEnd_Luudiem = Sheets("LuuDiem").Cells(2, 3).End(xlDown).Row
'---------Chep ten Ma de tu Sheets("LuuDA") sang sheets("LuuDiem")
Sheets("LuuDiem").Range("F1:DZ5000").Value = "" 'Xoa du lieu
iEnd_Made = Sheets("LuuDA").Cells(1, 6).End(xlDown).Row
For iMade = 2 To iEnd_Made
    Sheets("LuuDiem").Cells(1, iMade + 4).Value = Sheets("LuuDA").Cells(iMade, 6).Value
Next iMade
'-----------Tim hoc sinh+made trong sheets("HsNop") de tinh diem
For iMade = 2 To iEnd_Made
iEnd_DA = Sheets("LuuDA").Cells(iMade, 5).Value + 6
'Kiem tra cac dieu kien co du lieu va code chay duoc cac vong lap for
If iEnd_DA < 7 Or iEnd_Luudiem < 2 Or iEnd_Nop < 2 Then
   Exit Sub
End If
'------bat dau kiem tra va tinh diem
For ir_Luudiem = 2 To iEnd_Luudiem
iMark = "K.Nop"
For ir_Nop = 2 To iEnd_Nop
    If Sheets("LuuDiem").Cells(ir_Luudiem, 3) = Sheets("HsNop").Cells(ir_Nop, 3) And Sheets("HsNop").Cells(ir_Nop, 5) = Sheets("LuuDA").Cells(iMade, 6) Then
        iMark = 0
        For ic_DA = 7 To iEnd_DA
            If Sheets("luuDA").Cells(iMade, ic_DA) = Sheets("HsNop").Cells(ir_Nop, ic_DA) Then
                iMark = iMark + 1
            End If
        Next ic_DA
        iMark = Round(iMark / (iEnd_DA - 6) * 10, 2)
        ir_Nop = iEnd_Nop
    End If
Next ir_Nop
Sheets("LuuDiem").Cells(ir_Luudiem, iMade + 4) = iMark
Next ir_Luudiem
Next iMade
End Sub
hoặc File cụ thể sau
 

File đính kèm

Web KT

Bài viết mới nhất

Back
Top Bottom