17

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

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

4

3 回答 3

9

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
于 2013-07-15T15:06:26.410 回答
5

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

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
于 2013-07-15T17:47:00.430 回答
1

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

在我自己的拙见中，在 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
于 2013-07-15T15:05:41.013 回答