Создать словарь списков в 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, С++ и python, с stuft like 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

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

Ответ 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 

Ответ 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 already there, set the child to what 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 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

Ответ 3

Я не знаком с С++ и 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