在vba中创建列表字典

Question

我之前在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

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

'key' 'values':

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

然后通过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

这似乎有点乏味.有更好的方法吗？我试图寻找在VBA中使用数组,它似乎比Java,C++和Python的有点不同,有stuft喜欢redim preserve和喜欢.这是在vba中使用数组的唯一方法吗？

我的解决方案

基于@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

请注意,此解决方案假定所有设备都已排序!

Answer 1

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

• 可以对数组进行重新定义(尽管不是必需的).
• 大多数数组属性(例如,Sheets工作簿中的数组)都是基于1的.虽然正如@TimWilliams正确指出的那样,用户定义的数组实际上是基于0的.下面的数组定义了一个长度为11的字符串数组(10表示上部位置).

除此之外以及关于符号的特殊性,您不应该发现任何处理VBA数组的问题.

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

关于您的请求,您可以在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 

Answer 2

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

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