Создание словаря списков в 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_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

обратите внимание, что это решение предполагает, что все оборудование сортируются!

11
dictionary vba

3 ответов

массивы в VBA более или менее похожи на все остальные с различными особенностями:

  • Redimensioning массив возможен (хотя и не требуется).
  • большинство свойств массива (например,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

вы можете иметь словари в словари. Нет необходимости использовать массивы или коллекции, если у вас нет особой необходимости.

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

Я не так хорошо знаком с 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
1