Question

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

但是，我有一个（可怕的）电子表格，在一列中有数百次重复的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)

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

然后，我需要收集每个集合。

Answer 1

我会考虑使用Dictionary集合，与标准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

动态创建集合VBA

1 个答案: