dynamic创build集合VBA的集合

我试图dynamic创build一个集合嵌套在集合。 到目前为止,我已经能够通过input一切来创build一个嵌套集合(见下文)。

但是,我有一个( 可怕的 )电子表格,其中一列有17个问题的重复数百次,下一列有答案。 我试图把每个问题的答案作为一个项目,而问题本身作为索引。 这17个问题的唯一集合将是整个电子表格集合中的一个集合。 如果没有任何意义,可以考虑为集合中的每个项目添加一个集合。

以下是手动input的集合的集合:

谢谢!

Sub test() Dim M As New Collection Dim nst3 As New Collection Dim nst2 As New Collection Dim nst1 As New Collection Dim i As Integer Dim ii As Integer nst1.Add "A", "1" nst1.Add "B", "2" nst1.Add "C", "3" nst1.Add "D", "4" nst2.Add "E", "1" nst2.Add "F", "2" nst2.Add "G", "3" nst2.Add "H", "4" nst3.Add "I", "1" nst3.Add "J", "2" nst3.Add "K", "3" nst3.Add "L", "4" M.Add nst1, "Nested_Collection_A" M.Add nst2, "Nested_Collection_B" M.Add nst3, "Nested_Collection_C" For i = 1 To M.Count For ii = 1 To M(i).Count Debug.Print M(i)(ii) Next ii Next i End Sub 

编辑:

在D列中,我将这些值重复了一遍,结束了不确定的时间。 E栏有回应。

 Date posting/bagging will end?(R) Date to post/bag location(s)s or meter(s)?(R) Location 1: Location 2: Location 3: Location 4: Location 5: Location 6: Purpose of Posting/Bagging? Service Request is from an AMENDED permit(R)? Side of street to Post/Bag?(R) Special instructions to Bureau of Traffic Services? Time posted/bagged begins?(R) Time posted/baggged ends?(R) Type of action required?(R) 

我试图得到每个问题都是索引的集合,每个答案都是这个项目。

那么,我需要收集每个集合。

我会考虑一个集合词典 ,而不是像一个标准的VBA集合那样检索键列表是不可能的。 假设你有你在Col A上的问题清单和在Col B上的答案,你可以这样做:

 Sub ReadQuestions() Row = 1 Dim QA As Object Set QA = CreateObject("Scripting.Dictionary") Dim Ans As Collection Do 'Get Q & A for current row question = Cells(Row, 1).text answer = Cells(Row, 2).text 'Tests if last filled row If question = "" Then Exit Do 'If question is duplicate append answer to the current answer collection for that question If QA.Exists(question) Then QA(question).Add answer 'If new question, add a collection of answers with one member (so far) to it Else Set Ans = New Collection Ans.Add answer Set QA(question) = Ans End If Row = Row + 1 Loop Set Ans = Nothing 'Now a simple test 'Notice that Dictionnary.Keys() is a zero-based array FirstQuestion = QA.Keys()(0) NAnswers = QA(FirstQuestion).Count 'On the other hand, Collections are one-based FirstAnswer = QA(FirstQuestion).Item(1) MsgBox "First question '" & FirstQuestion & "' has " & NAnswers & " answers. The first answer is '" & FirstAnswer & "'" End Sub