Excel 在VBA中动态创建集合的集合

我正在尝试动态创建一个集合，集合嵌套在其中。到目前为止，我已经能够通过键入所有内容来创建嵌套集合（见下文）

然而，我有一个（可怕的）电子表格，在一个专栏中有一组重复的17个问题数百次，答案在下一个专栏中。我试图将每个问题的答案作为一个项目，并将问题本身作为索引。17个问题的独特集合将是整个电子表格集合中的一个集合。如果这没有意义，可以考虑为集合中的每个项目创建一个集合

以下是手动键入的集合集合集合：

谢谢

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)

我试图得到一个集合，其中每个问题都是索引，每个答案都是项目

那么，我需要每个集合的集合。

< P>我会考虑一个集合，就像用标准的VBA集合一样，不可能检索密钥列表。 假设你在A栏有问题列表，在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

我会考虑一个集合，就像使用一个标准的VBA集合一样，不可能检索密钥列表。 假设你在A栏有问题列表，在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

---

为什么不对数据进行排序并使用数组呢？也许如果我们知道你的代码的目的，我们可以提供更好的解决方案。我不清楚你的要求。但也许你可以创建一个类来表示一组问题及其答案；填补这一空缺；然后将该类的多个实例收集到一个集合中。每个问题将由一个类属性表示；答案是分配给该属性的值。为什么不对数据进行排序并使用数组呢？也许如果我们知道你的代码的目的，我们可以提供更好的解决方案。我不清楚你的要求。但也许你可以创建一个类来表示一组问题及其答案；填补这一空缺；然后将该类的多个实例收集到一个集合中。每个问题将由一个类属性表示；答案是分配给该属性的值。是的，这样更好。解决一切问题。谢谢是的，这样更好。解决一切问题。谢谢