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