1、在工作表“Sheet1”里，命令按鈕點(diǎn)擊事件，工作表Change事件，調(diào)用判分過(guò)程：Private Sub CmdScore_Click() Dim arr(), i As Long, rng As Range Dim lRow As Long lRow = UsedRange.Rows.Count Set rng = Cells(1, 1).Resize(lRow, 4) arr = rng.Value For i = 2 To UBound(arr) arr(i, 4) = getScore(6, CStr(arr(i, 3)), CStr(arr(i, 2))) Next rng.Value = arr MsgBox "Done!"End Sub
Private Sub Worksheet_Change(ByVal Target As Range) Dim currRow As Long If Target.CountLarge > 1 Then Exit Sub If Target.Row > 1 Then If Target.Column = 2 Or Target.Column = 3 Then currRow = Target.Row Cells(currRow, 4) = getScore(6, CStr(Cells(currRow, 3)), CStr(Cells(currRow, 2))) End If End IfEnd Sub
2、在myModule里，getScore自定義函數(shù)，根據(jù)相應(yīng)參數(shù)得出分?jǐn)?shù)：Option ExplicitFunction getScore( _ totalScore As Integer, _ rightAnswer As String, _ studentAnswer As String) '//totalScore:單題總分 '//rightAnswer：正確答案 '//studentAnswer：學(xué)生答案 Dim unitScore As Double Dim currScore As Double Dim i As Integer '//答案都轉(zhuǎn)為大寫 rightAnswer = UCase(rightAnswer) studentAnswer = UCase(studentAnswer) '//如果標(biāo)準(zhǔn)答案為空，退出函數(shù) If rightAnswer = "" Then Exit Function '//每個(gè)選項(xiàng)得分 unitScore = Round(totalScore / Len(rightAnswer), 2) If studentAnswer = "" Or Len(studentAnswer) > Len(rightAnswer) Then '//如果學(xué)生答案為空或者多于標(biāo)準(zhǔn)答案，得0分 getScore = 0 Exit Function End If '//循環(huán)判斷學(xué)生答案的每個(gè)選項(xiàng)，如果沒(méi)有錯(cuò)誤選項(xiàng)，按答對(duì)個(gè)數(shù)得分， '//否則，得0分 For i = 1 To Len(studentAnswer) If InStr(rightAnswer, Mid(studentAnswer, i, 1)) > 0 Then currScore = currScore + unitScore Else getScore = 0 Exit Function End If Next getScore = currScoreEnd Function
|
