在 VBA、Excel 中自动创建不同的、可识别的集合

Question

所以我有大量的玩具卡车，我将它们存放在一个集合中（因为一开始我不知道会有多少辆卡车），每辆卡车都有很多属性，例如数量销售，价格，轴距等。这些卡车的一个具体属性是重量限制，即这个玩具可以承载多少重量，只有一定数量的不同重量限制，但我不知道会有多少当我启动宏时。

我想要做的是遍历集合并将卡车添加到特定于其重量的不同集合中，但如上所述，我不知道会有多少不同的重量限制。

所以我想我的问题是如何自动创建可以轻松识别的集合，当发现具有新重量限制的卡车循环通过所有卡车时创建每个集合？

例如，如果我有 10 辆卡车，其中 6 辆可以运载 2 公斤，4 辆可以运载 3 公斤，我会想要两个系列，将 2 公斤和 3 公斤的卡车分开。

我曾考虑过创建一个 3 维数组，但这会涉及很多“空白空间”，其中一些重量限制比其他限制更常见，因此需要更多代码来处理这个问题，这并不理想。至于创建锯齿状数组，我遇到了同样的问题，即不知道如何自动创建不同的、易于识别的数组。

理想情况下，我想做的是动态创建一个二维数组，其中第一行是重量限制，第二行是对集合的引用（当新的重量限制添加到数组时自动创建） ，但我认为这是不可能的......（由于 ReDim Preserve 包含重量限制的行）

这是我目前正在做的事情，但显然它并不理想： （而且，重量限制不会每次都增加2）

For Each v In collTruck
    If v.WeightLimit = 8 Then
        coll8.Add v
    ElseIf v.WeightLimit = 10 Then
        coll10.Add v
    ElseIf v.WeightLimit = 12 Then
        coll12.Add v
    ElseIf v.WeightLimit = 14 Then
        coll14.Add v
    Else: collOtherW.Add v
    End If
Next v

Set collWeights = New Collection
collWeights.Add c8
collWeights.Add c10
collWeights.Add c12
collWeights.Add c14
collWeights.Add cOtherW

Answer 1

下面的函数将卡车集合作为参数，并返回包含与不同重量限制一样多的子集合的集合。每个此类子集合都包含具有此特定重量限制的所有卡车。

Public Function divideIntoCollections(trucks As Collection) As Collection
    Dim objTruck As Truck
    Dim colWeightGroup As Collection
    Dim weightLimit As Double
    '----------------------------------------------------------------


    Set divideIntoCollections = New Collection


    For Each objTruck In trucks

        weightLimit = objTruck.weightLimit

        'Try to find a subcollection having the same key as the 
        'weight limit of the current truck.
        On Error Resume Next
        Set colWeightGroup = divideIntoCollections.Item(CStr(weightLimit))
        On Error GoTo 0

        'If such subgroup has not been found, it means
        'this is the first truck with such weight limit.
        'We need to create a new subcollection for trucks
        'with such weight limit and add it to the result collection.
        If colWeightGroup Is Nothing Then
            Set colWeightGroup = New Collection
            Call divideIntoCollections.Add(Item:=colWeightGroup, Key:=CStr(weightLimit))
        End If


        'Add current truck to the proper subcollection.
        Call colWeightGroup.Add(Item:=objTruck)


    Next objTruck


End Function

一些如何使用它的例子：

Sub Main()
    Dim trucks As Collection
    Dim trucksByWeight As Collection
    '--------------------------------------------------

    Set trucks = LoadCollection '<-- your own method to initially
                                '    load trucks into collection.

    Set trucksByWeight = divideIntoCollections(trucks)


    'Here is how you can get access to the trucks with the given weight.
    Dim trucks12 As Collection
    Set trucks12 = trucksByWeight.item("12")


    'Here is how you can print all weight limits and the number of trucks
    'appended to this group.
    Dim subCol As Object
    For Each subCol In trucksByWeight
        Debug.Print " Weight limit: " & subCol.item(1).weightLimit & _
                    " Trucks: " & subCol.Count
    Next item


End Sub

Answer 2

以下是如何用重量限制和集合填充数组：

Sub FillArray()

Dim arr() As Variant
Dim col123 As Collection

Set col123 = New Collection
col123.Add 1, "FirstKey"
col123.Add "Whatever", "Foo"

ReDim arr(1 To 2, 1 To 1) As Variant
arr(1, 1) = 1000
Set arr(2, 1) = col123

ReDim Preserve arr(1 To 2, 1 To 2) As Variant
Set col123 = New Collection
col123.Add "Something", "InSomeKey"
col123.Add "Another thing", "In another key"
arr(1, 2) = 2000
Set arr(2, 2) = col123

End Sub