VBE修改

sillykin

下面程式為檢查是否有在 A2 或 A3 儲存格輸入了答案
若A2~A201要有下面的方式,要如何修改VBA?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim answerCell As Range
Dim correctnessCell As Range
Dim correctCount As Integer
Dim wrongCount As Integer

Set answerCell = Range("A2")
Set correctnessCell = Range("F2")
correctCount = Range("H2").Value
wrongCount = Range("I2").Value

' 檢查是否有在 A2 或 A3 儲存格輸入了答案
If Not Intersect(Target, answerCell) Is Nothing Then
    ' 檢查對應的判斷儲存格是否為 "TRUE" (正確)
    If UCase(correctnessCell.Value) = "TRUE" Then
        ' 正確次數累加
        correctCount = correctCount + 1
        Range("H2").Value = correctCount
    ElseIf UCase(correctnessCell.Value) = "FALSE" Then
        ' 錯誤次數累加
        wrongCount = wrongCount + 1
        Range("I2").Value = wrongCount
    End If
ElseIf Not Intersect(Target, Range("A3")) Is Nothing Then
    ' 檢查對應的判斷儲存格是否為 "TRUE" (正確)
    If UCase(Range("F3").Value) = "TRUE" Then
        ' 正確次數累加
        correctCount = Range("H3").Value + 1
        Range("H3").Value = correctCount
    ElseIf UCase(Range("F3").Value) = "FALSE" Then
        ' 錯誤次數累加
        wrongCount = Range("I3").Value + 1
        Range("I3").Value = wrongCount
    End If
End If

Andy2483

回復 1# sillykin


Private Sub Worksheet_Change(ByVal Target As Range)
With Target
   If .Columns.Count > 1 Then Exit Sub
   If .Count > 1 Then Exit Sub
   If Intersect([A2:A200], .Cells) Is Nothing Then Exit Sub
   If UCase(.Item(1, 6)) = "TRUE" Then
      .Item(1, 8) = .Item(1, 8) + 1
      ElseIf UCase(.Item(1, 6)) = "FALSE" Then
      .Item(1, 9) = .Item(1, 9) + 1
   End If
End With
End Sub

sillykin

謝謝你的協助