问题 在vba中创建列表字典


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

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


5463
2017-07-15 14:24


起源

...将所有内容添加到字典失败,因为相同的键被添加了几次(因为它应该) 我不跟着你。即使在python,a dict object只能包含唯一键值。 - David Zemens
您是否可以添加ID列并将其用作密钥?
你绝对可以做到这一点,如果你发现它太冗长了,不幸的是VBA与其他语言相比的本质......有一点需要注意:当它仍然在字典中时,不要试图修改数组:你需要通过将其分配给变量来将其拉出,展开它(使用Redim Preserve),然后将其重新分配回字典。 - Tim Williams
@DavidZemens是的,糟糕的句子没有给问题增加任何价值。它被删除了。 - Krøllebølle
@TimWilliams你不能直接修改数组的原因是什么?通过引用/值传递的东西?似乎这也是我的解决方案的情况 - 必须提取集合,添加数据,将其从字典中删除并重新添加。不是因为这是静态的,所以这很重要,只读一次数据。 - Krøllebølle


答案:


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 

7
2017-07-15 15:06



这是我了解正在发生的事情的最简单方法,谢谢! - Krøllebølle
不用谢。 - varocarbas
除非您使用,否则VBA中的数组默认情况下为0,而不是基于1 Option Base 1。 MsgBox LBound(Array(1,2,3)) 会给 0 - Tim Williams
通过使用上述语句对数组进行维度而不执行任何其他修改时,它将获得1个基数。这个数组是1基数。如果你依赖于其他尺寸标注(今天我在这条线上回复了一个帖子的数组类型),它就是零基础。所以我不认为你可以在这方面征税。真实的是,VBA中的大多数属性都是基于1的,我在我的例子中编写的数组类型是1-base - varocarbas
@TimWilliams我已经更新了我的答案,我希望你能相应地更新你的陈述(或告诉我我的错误)。 - varocarbas


你可以在词典中使用词典。除非您有特殊需要,否则无需使用数组或集合。

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

4
2017-07-15 17:47



我认为这不适用于这个特定问题,因为我需要为每个密钥存储多个项目。或许我在这里误解了一些东西? - Krøllebølle
它与varocarbas的答案相同,除了不是将集合存储在字典中,我将字典存储在字典中。如果您已经引用了Scripting Runtime,我不知道您为什么要使用集合。 - Dick Kusleika
@Dick以什么方式比Dictionary更好,所以你说你喜欢Dict? - Ádám Bukovinszki
两件事: Exists 方法可以防止错误捕获方式查看集合中是否有东西,我最喜欢的是,您可以使用 Items 要么 Keys 创建一个数组。填充组合框非常方便。缺点是你只能添加到堆栈的末尾。 - Dick Kusleika


我不熟悉C ++和Python(很长一段时间)所以我不能真正说出与VBA的差异,但我可以说在VBA中使用Arrays并不是特别复杂。

在我自己的拙见中,在VBA中使用动态数组的最佳方法是将其标注为大量数据,并在完成向其添加元素时将其缩小。实际上,在保存数值的同时重新定义阵列的Redim Preserve具有巨大的性能成本。你不应该在循环中使用Redim Preserve,执行起来会非常缓慢

作为示例,调整以下代码:

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

1
2017-07-15 15:05



或者,你可以 ReDim Flanged_Connections(0 to wS.Cells(1, 1).CurrentRegion.Rows.Count) 在开始。这避免了在最后收缩数组的需要,并且不会因为不必要的大小分配而混淆代码。 - David Zemens
你会得到一个不完美尺寸的数组,因为在他给出的例子中它的大小为10,而不是大小为3.所以如果你想使用Ubound,你仍然需要缩小它 - Julien Marrec
重点是它会 最 理想的是最初适当地标注你的数组,即使用一些逻辑来确定合适的数组 UBOUND然后最初设置。如果这种情况可能不适用于这种情况 UBOUND 无法在循环之前确定。干杯。 - David Zemens
我完全同意(我赞成你的评论)。无论如何,最好使用你最初提出的内容,而不是像我一样使用任意值。我会用countif更新我的答案 - Julien Marrec