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有点不同，像redim preserve这样的stuft等。这是在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

Answer 3

我不熟悉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

在vba中创建列表字典

我的解决方案：

3 个答案: