Mong các bạn hướng dẫn cánh tính điểm trong câu hỏi trắc nghiệm !!

Liên hệ QC
Tôi tuân thủ nội quy khi đăng bài
1 cách: Khi bạn thay đổi đáp án thì kết quả sẽ tự động cập nhật

PHP:
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim k&, cell As Range, st As String, st2 As String
Dim res(1 To 16, 1 To 2)
If Intersect(Target, Range("C4:J4")) Is Nothing Then Exit Sub
For Each cell In Range("C4:J4")
    If Len(cell) > 3 Then st = IIf(st = "", "", st) & cell.Offset(-1, 0)
Next
If Len(st) = 4 Then
    res(1, 1) = st: res(1, 2) = 1
    res(2, 1) = Left(st, 3): res(2, 2) = "0,75"
    res(3, 1) = Left(st, 2) & Right(st, 1): res(3, 2) = "0,75"
    res(4, 1) = Right(st, 3): res(4, 2) = "0,75"
    
    res(6, 1) = Left(st, 2): res(6, 2) = "0.5"
    res(7, 1) = Left(st, 1) & Mid(st, 3, 1): res(7, 2) = "0.5"
    res(8, 1) = Left(st, 1) & Mid(st, 4, 1): res(8, 2) = "0.5"
    res(9, 1) = Mid(st, 2, 1) & Mid(st, 3, 1): res(9, 2) = "0.5"
    res(10, 1) = Mid(st, 2, 1) & Mid(st, 4, 1): res(10, 2) = "0.5"
    res(11, 1) = Mid(st, 3, 1) & Mid(st, 4, 1): res(11, 2) = "0.5"
    
    res(13, 1) = Left(st, 1): res(13, 2) = "0.5"
    res(14, 1) = Mid(st, 2, 1): res(14, 2) = "0.5"
    res(15, 1) = Mid(st, 3, 1): res(15, 2) = "0.5"
    res(16, 1) = Mid(st, 4, 1): res(16, 2) = "0.5"

    Range("C7").Resize(16, 2).Value = res
End If
End Sub
 

File đính kèm

  • Tính điểm trắc nghiệm.xlsm
    18.8 KB · Đọc: 3
Web KT
Back
Top Bottom