动态创建馆藏VBA的馆藏 [英] Dynamically Create collection of Collections VBA

问题描述

我正在尝试动态创建一个嵌套有集合的集合.到目前为止，我已经可以通过键入所有内容来创建嵌套集合(请参见下文).

I'm trying to dynamically create a collection with collections nested within. So far, I've been able to create a nested collection by typing everything (see below).

但是，我有一个(可怕的)电子表格，该电子表格的一列中包含数百个重复的17个问题集，而下一列中的答案则是重复的.我试图将每个问题的答案作为项目，并将问题本身作为索引.这17个问题的唯一集合将是整个电子表格的集合中的一个集合.如果那没有道理，请考虑为一个集合中的每个项目都拥有一个集合.

However, I have a (horrible) spreadsheet that has a repeating set of 17 questions hundreds of times in one column, and the answers in the next column. I'm trying to get the answer to each question as an item, and the question itself as the index. The unique set of the 17 questions will be a collection within a collection of the entire spreadsheet. If that doesn't make sense, think about having a collection for each item in a collection.

以下是手动输入的集合的集合:

Here's the collection of collections that is manually typed:

谢谢！

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列有响应.

In column D, I have these values repeating over, and over for an indeterminate amount of times. And column E has the response.

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)

我正在尝试收集每个问题在哪里，每个答案在哪里的项目.

I'm trying to get a collection of where each question is the index and each answer is the item.

然后，我需要每个集合的一个集合.

Then, I need a collection of each collection.

推荐答案

我会考虑使用

I would consider a Dictionary of Collections instead, as with a standard VBA Collection it is not possible to retrieve the list of keys. Suppose you have your list of questions on Col A and answers on Col B, you could do something like:

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的馆藏的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！