在 vba 中创建列表字典

Create dictionary of lists in vba

提问by Kr?lleb?lle

I have worked in Python earlier where it is really smooth to have a dictionary of lists (i.e. one key corresponds to a list of stuff). I am struggling to achieve the same in vba. Say I have the following data in an excel sheet:

我之前曾在 Python 中工作过，其中拥有一个列表字典（即一个键对应于一个东西列表）真的很顺利。我正在努力在 vba 中实现相同的目标。假设我在 Excel 表中有以下数据：

Flanged_connections 6
Flanged_connections 8
Flanged_connections 10
Instrument  Pressure
Instrument  Temperature
Instrument  Bridle
Instrument  Others
Piping  1
Piping  2
Piping  3

Now I want to read the data and store it in a dictionary where the keys are Flanged_connections, Instrumentand Pipingand the values are the corresponding ones in the second column. I want the data to look like this:

现在我想读取数据并将其存储在字典中，其中键是Flanged_connections，Instrument而Piping值是第二列中的相应值。我希望数据看起来像这样：

'key' 'values':

'Flanged_connections' '[6 8 10]'
'Instrument' '["Pressure" "Temperature" "Bridle" "Others"]'
'Piping' '[1 2 3]'

and then being able to get the list by doing dict.Item("Piping")with the list [1 2 3]as the result. So I started thinking doing something like:

然后能够通过dict.Item("Piping")将列表[1 2 3]作为结果来获取列表。所以我开始考虑做一些类似的事情：

For Each row In inputRange.Rows

    If Not equipmentDictionary.Exists(row.Cells(equipmentCol).Text) Then
        equipmentDictionary.Add row.Cells(equipmentCol).Text, <INSERT NEW LIST>
    Else
        equipmentDictionary.Add row.Cells(equipmentCol).Text, <ADD TO EXISTING LIST>
    End If

Next

This seems a bit tedious to do. Is there a better approach to this? I tried searching for using arrays in vba and it seems a bit different than java, c++ and python, with stuft like redim preserveand the likes. Is this the only way to work with arrays in vba?

这样做似乎有点乏味。有没有更好的方法来解决这个问题？我尝试在 vba 中搜索使用数组，它似乎与 java、c++ 和 python 有点不同，有类似redim preserve的东西。这是在 vba 中处理数组的唯一方法吗？

My solution:

我的解决方案：

Based on @varocarbas' comment I have created a dictionary of collections. This is the easiest way for my mind to comprehend what's going on, though it might not be the most efficient. The other solutions would probably work as well (not tested by me). This is my suggested solution and it provides the correct output:

根据@varocarbas 的评论，我创建了一个集合字典。这是让我的头脑理解正在发生的事情的最简单方法，尽管它可能不是最有效的。其他解决方案可能也能工作（未经我测试）。这是我建议的解决方案，它提供了正确的输出：

'/--------------------------------------\'
'| Sets up the dictionary for equipment |'
'\--------------------------------------/'

inputRowMin = 1
inputRowMax = 173
inputColMin = 1
inputColMax = 2
equipmentCol = 1
dimensionCol = 2

Set equipmentDictionary = CreateObject("Scripting.Dictionary")
Set inputSheet = Application.Sheets(inputSheetName)
Set inputRange = Range(Cells(inputRowMin, inputColMin), Cells(inputRowMax, inputColMax))
Set equipmentCollection = New Collection

For i = 1 To inputRange.Height
    thisEquipment = inputRange(i, equipmentCol).Text
    nextEquipment = inputRange(i + 1, equipmentCol).Text
    thisDimension = inputRange(i, dimensionCol).Text

    'The Strings are equal - add thisEquipment to collection and continue
    If (StrComp(thisEquipment, nextEquipment, vbTextCompare) = 0) Then
        equipmentCollection.Add thisDimension
    'The Strings are not equal - add thisEquipment to collection and the collection to the dictionary
    Else
        equipmentCollection.Add thisDimension
        equipmentDictionary.Add thisEquipment, equipmentCollection
        Set equipmentCollection = New Collection
    End If

Next

'Check input
Dim tmpCollection As Collection
For Each key In equipmentDictionary.Keys

    Debug.Print "--------------" & key & "---------------"
    Set tmpCollection = equipmentDictionary.Item(key)
    For i = 1 To tmpCollection.Count
        Debug.Print tmpCollection.Item(i)
    Next

Next

Note that this solution assumes that all the equipment are sorted!

请注意，此解决方案假设所有设备都已排序！

采纳答案by varocarbas

Arrays in VBA are more or less like everywhere else with various peculiarities:

VBA 中的数组或多或少像其他地方一样，具有各种特性：

• Redimensioning an array is possible (although not required).
• Most of the array properties (e.g., Sheetsarray in a Workbook) are 1-based. Although, as rightly pointed out by @TimWilliams, the user-defined arrays are actually 0-based. The array below defines a string array with a length of 11 (10 indicates the upper position).

• 可以重新调整数组的大小（尽管不是必需的）。
• 大多数数组属性（例如，Sheets工作簿中的数组）都是从 1 开始的。尽管正如@TimWilliams 正确指出的那样，用户定义的数组实际上是基于 0 的。下面的数组定义了一个长度为 11 的字符串数组（10 表示上位）。

Other than that and the peculiarities regarding notations, you shouldn't find any problem to deal with VBA arrays.

除了这一点以及有关符号的特殊性之外，您应该不会发现处理 VBA 数组的任何问题。

Dim stringArray(10) As String
stringArray(1) = "first val"
stringArray(2) = "second val"
'etc.

Regarding what you are requesting, you can create a dictionary in VBA and include a list on it (or the VBA equivalent: Collection), here you have a sample code:

关于您的要求，您可以在 VBA 中创建一个字典并在其中包含一个列表（或 VBA 等效项：）Collection，这里有一个示例代码：

Set dict = CreateObject("Scripting.Dictionary")
Set coll = New Collection
coll.Add ("coll1")
coll.Add ("coll2")
coll.Add ("coll3")
If Not dict.Exists("dict1") Then
    dict.Add "dict1", coll
End If

Dim curVal As String: curVal = dict("dict1")(3) '-> "coll3"

Set dict = Nothing 

回答by Dick Kusleika

You can have dictionaries within dictionaries. No need to use arrays or collections unless you have a specific need to.

您可以在字典中包含字典。除非您有特殊需要，否则无需使用数组或集合。

Sub FillNestedDictionairies()

    Dim dcParent As Scripting.Dictionary
    Dim dcChild As Scripting.Dictionary
    Dim rCell As Range
    Dim vaSplit As Variant
    Dim vParentKey As Variant, vChildKey As Variant

    Set dcParent = New Scripting.Dictionary

    'Don't use currentregion if you have adjacent data
    For Each rCell In Sheet2.Range("A1").CurrentRegion.Cells
        'assume the text is separated by a space
        vaSplit = Split(rCell.Value, Space(1))

        'If it's already there, set the child to what's there
        If dcParent.Exists(vaSplit(0)) Then
            Set dcChild = dcParent.Item(vaSplit(0))
        Else 'create a new child
            Set dcChild = New Scripting.Dictionary
            dcParent.Add vaSplit(0), dcChild
        End If
        'Assumes unique post-space data - text for Exists if that's not the case
        dcChild.Add CStr(vaSplit(1)), vaSplit(1)
    Next rCell

    'Output to prove it works
    For Each vParentKey In dcParent.Keys
        For Each vChildKey In dcParent.Item(vParentKey).Keys
            Debug.Print vParentKey, vChildKey
        Next vChildKey
    Next vParentKey

End Sub

回答by Julien Marrec

I am not that familiar with C++ and Python (been a long time) so I can't really speak to the differences with VBA, but I can say that working with Arrays in VBA is not especially complicated.

我不太熟悉 C++ 和 Python（已经很长时间了），所以我不能真正谈论与 VBA 的区别，但我可以说在 VBA 中使用数组并不是特别复杂。

In my own humble opinion, the best way to work with dynamic arrays in VBA is to Dimension it to a large number, and shrink it when you are done adding elements to it. Indeed, Redim Preserve, where you redimension the array while saving the values, has a HUGE performance cost. You should NEVER use Redim Preserve inside a loop, the execution would be painfully slow

以我个人的拙见，在 VBA 中使用动态数组的最佳方法是将其维度化为一个较大的数字，并在向其添加元素后将其缩小。事实上，Redim Preserve（在保存值的同时重新定义数组的大小）具有巨大的性能成本。你永远不应该在循环中使用 Redim Preserve，执行会非常缓慢

Adapt the following piece of code, given as an example:

修改下面的一段代码，举个例子：

Sub CreateArrays()

Dim wS As Worksheet
Set wS = ActiveSheet

Dim Flanged_connections()
ReDim Flanged_connections(WorksheetFunction.CountIf(wS.Columns(1), _
    "Flanged_connections"))

For i = 1 To wS.Cells(1, 1).CurrentRegion.Rows.Count Step 1

    If UCase(wS.Cells(i, 1).Value) = "FLANGED_CONNECTIONS" Then   ' UCASE = Capitalize everything

        Flanged_connections(c1) = wS.Cells(i, 2).Value

    End If

Next i

End Sub