Excel 代码中的危险对板上的每个图块都会出现相同的问题

Question

我正在尝试在 Excel 中制作 Jeopardy，但按下按钮已经引起了麻烦。我还没到积分呢

If Target.Value = 200 Then
    Set Category = Target.Offset(-4, 0)
    Dim rowIndex As Variant
    rowIndex = Application.Match(Target.Value, Category, 0)
    If Not IsError(rowIndex) Then
        question = QuestionsSheet.Cells(Category.Row + rowIndex - 1, 3).Value
        answer = QuestionsSheet.Cells(Category.Row + rowIndex - 1, 8).Value
        Category.Value = QuestionsSheet.Cells(Category.Row, Category.Column - 1).Value
        MsgBox question, vbQuestion, "Jeopardy"
        If InputBox("Enter your answer:", "Jeopardy") = answer Then
            MsgBox "Correct!", vbInformation, "Jeopardy"
        Else
            MsgBox "Incorrect. The correct answer is: " & answer, vbExclamation, "Jeopardy"
        End If
    End If
End If


If Target.Value = 300 Then
    Set Category = Target.Offset(-5, 0)
    question = QuestionsSheet.Cells(Category.Row, 3).Value
    answer = QuestionsSheet.Cells(Category.Row, 8).Value
    Category.Value = ""
    MsgBox question, vbQuestion, "Jeopardy"
    If InputBox("Enter your answer:", "Jeopardy") = answer Then
        MsgBox "Correct!", vbInformation, "Jeopardy"
    Else
        MsgBox "Incorrect. The correct answer is: " & answer, vbExclamation, "Jeopardy"
    End If
End If

这是代码的一部分。我从 100 到 400 的值。我试图让用户单击一个值，然后该值找到类别，计算机使用该数据在“问题”页面上查找相应的数据。这些按钮可以工作，但每个按钮都会出现相同的问题，即 300 分问题，所以我不知道代码中是否有问题，但我就是无法让它工作。

当选择板单元格时，我尝试手动引用“问题”页面上的单元格，但这导致了循环。我还尝试了 match、index、Application.WorksheetFunction、上面的不同品种等

董事会：

问题：

Answer 1

我实际上并不熟悉 Jeopardy 的规则，所以你可能需要调整一下：-

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Not Application.Intersect(Target, Me.Range("C7:F10")) Is Nothing Then
        If Target.Interior.Color = vbRed Then Exit Sub
        Dim x As Long, y As Long
        x = Target.Column - 2
        y = Target.Row - 6
        Dim questionRow As Long
        questionRow = (x - 1) * 4 + y
        Dim question As String
        question = QuestionSheet.Cells(questionRow + 1, 3)
        Dim answer As String
        answer = QuestionSheet.Cells(questionRow + 1, 8)
        MsgBox question, vbQuestion, "Jeopardy"
        If Strings.LCase$(InputBox("Enter your answer:", "Jeopardy")) = answer Then
            MsgBox "Correct!", vbInformation, "Jeopardy"
        Else
            MsgBox "Incorrect. The correct answer is: " & answer, vbExclamation, "Jeopardy"
        End If
        Target.Interior.Color = vbRed
    End If
End Sub