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。