В коде Jeopardy в Excel один и тот же вопрос возникает для каждой плитки на доске
Я пытаюсь сделать Jeopardy в Excel, и нажатие кнопки уже вызывает проблемы. Я еще даже до баллов не добрался.
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, различные варианты, описанные выше, и т. д.
Совет:
Вопросы:
Ааа, ок, я понял, что вставил это, и из-за этого ChatGPT странно работал с кодом? Не могли бы вы рассказать мне, как лучше индексировать вопросы?
Я был бы готов, да, но в вашем вопросе в настоящее время отсутствуют необходимые детали, то есть расположение ваших данных, поэтому вам могут помочь снимки экрана (включая номера строк и заголовки столбцов) с указанием также местоположения Target.
Я добавил две фотографии: одну для доски и одну для вопросника. Спасибо за помощь!
Ответы 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 questionRow As Variant
questionRow = Application.Match(Me.Cells(4, 3).Value, QuestionSheet.Columns(2), 0)
If Not IsError(questionRow) Then
Dim x As Long, y As Long
x = Target.Column - 2
y = Target.Row - 6
questionRow = questionRow - 2 + (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 If
End Sub
Вы понимаете, что
Category— это всего лишь одна клетка? Я спрашиваю, потому что очень необычно использоватьMatchтолько с диапазоном поиска, состоящим из одной ячейки... (rowIndexбудет либо 1, либо ошибка, а результатQuestionsSheet.Cells(Category.Row + rowIndex - 1, 3).Valueбудет таким же, какQuestionsSheet.Cells(Category.Row, 3).Value)