VBA中的条件提问和多个提问

Question

我正在尝试开发一种在excel（VBA）中提问的方法。提问将以先前的答案为条件，或者继续进行问题集应变，或者如果没有出现在下一个问题集应变中。最后，如果每个应变，如果达到，id就像保存答案并将它们全部汇总到最后。

我会尝试放一些我已经开始的代码，但我不知道怎么做，甚至不确定它是否可能。

我添加了一幅关于如何设想逻辑的图片。

如果有人能提供帮助那就太棒了！

非常感谢

Answer 1

为了给你一些开始，试试这个：

Sub Questions()
Dim Answers() As String, strTemp As String
Dim SetCount As Integer, QCount As Integer

SetCount = 3 'Question Sets
QCount = 4 'Max Number of Question

ReDim Answers(SetCount, QCount) 'Stores Answers

For i = 1 To SetCount 'Loop trough Sets
    For j = 1 To QCount 'Loop trough Question
        Answers(i, j) = Message(Q(i & j), i) 'Message Returns Answers of Set i and Question j
        If Answers(i, j) = "" Or Answers(i, j) = "No" Then 'Exit if no more Question or "No"
            Exit For
        End If
    Next j
Next i

'Output
For i = 1 To SetCount
strTemp = strTemp & "Set" & i & ":" & vbNewLine
    For j = 1 To QCount
        strTemp = strTemp & vbTab & "Question " & j & ":" & Answers(i, j) & vbNewLine
    Next j
strTemp = strTemp & vbNewLine
Next i

MsgBox (strTemp) 'Print Answers
End Sub

Function Message(ByVal Question As String, ByVal Title As String) As String
If Question <> "Nothing" Then 'Valid Answers
    If MsgBox(Question, vbYesNo, Title) = vbYes Then
        Message = "Yes"
    Else
        Message = "No"
    End If
Else
    Message = "" 'No more Questions
End If
End Function

Function Q(ByVal Question As Integer) As String
'Stores Questions
Select Case Question
    Case 11: Q = "Set 1 Question 1"
    Case 12: Q = "Set 1 Question 2"
    Case 13: Q = "Set 1 Question 3"
    Case 21: Q = "Set 2 Question 1"
    Case 22: Q = "Set 2 Question 2"
    Case 23: Q = "Set 2 Question 3"
    Case 24: Q = "Set 2 Question 4"
    Case 31: Q = "Set 3 Question 1"
    Case 32: Q = "Set 3 Question 2"
    Case Else: Q = "Nothing"
End Select
End Function

问题存储在函数Q中。它将在“是”上继续使用相同的设置，并跳转到“否”上的下一组。添加新问题/集时，必须调整SetCount和QCount。