VBA中的条件性质疑和多重质疑品系

Question

我正试图开发一种在excel（VBA）中质疑的方法。质疑将取决于以前的答案，要么是对问题集进行压力测试，要么是否出现前往下一个问题集的压力。最后，如果每个菌株，如果达到，编号喜欢保存答案，并在最后汇总它们。

我会尝试把我已经开始的一些代码，但我不知道如何做到这一点，甚至不知道这是可能的。

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

如果任何人都可以提供帮助，那将是惊人的！

非常感谢

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。