Хранение словарей в массиве

Question

У меня есть словари, которые хотели сохранить в массиве. При добавлении словаря в массив возникает ошибка.

Ожидаемый результат должен быть примерно таким.

 [{"Name": "A1", "ID": "B1", "Device": "C1"}, {"Name": "A2", "ID": "B2", "Device": "C2"}, {"Name": "A3", "ID": "B3", "Device": "C3"}, ...]

Код ошибки:

Неверно количество аргументов или недопустимое присвоение свойств

Dim RowDict as Scripting.Dictionary
Dim RowList() as Variant

TotalRow = ThisWorkbook.Sheets(1).Cells(ThisWorkbook.Sheets(1).Rows.Count, 1).End(xlUp).Row
ReDim RowList(0)

for i = 0 to TotalRow
    Set RowDict = New Scripting.Dictionary
    RowDict.Add Key:="Name", Item:=SourceWS.Cells(i, 3)
    RowDict.Add Key:="ID", Item:=SourceWS.Cells(i, 4)
    RowDict.Add Key:="Device", Item:=SourceWS.Cells(i, 1)
    
    ReDim Preserve RowList(UBound(RowList) + 1)
    RowList(UBound(RowList)) = RowDict <-- Error here
Next i

Answer 1

ReDim Preserve не рекомендуется (с точки зрения обработки памяти), когда вы можете вычислить / вывести размер (а) массива ... Тогда словарь является объектом, и вы должны Set каждый элемент массива.

Private Sub testDictionariesArray()
  Dim RowDict As Scripting.Dictionary, TotalRow As Long, i As Long
  Dim RowList As Variant, SourceWS As Worksheet

  Set SourceWS = ThisWorkbook.Sheets(1)
  TotalRow = SourceWS .Cells(Rows.count, 1).End(xlUp).row
  
  ReDim RowList(TotalRow)

    For i = 1 To TotalRow
        Set RowDict = New Scripting.Dictionary
        RowDict.aDD key:="Name", Item:=SourceWS.Cells(i, 3)
        RowDict.aDD key:="ID", Item:=SourceWS.Cells(i, 4)
        RowDict.aDD key:="Device", Item:=SourceWS.Cells(i, 1)
        Set RowList(i) = RowDict
    Next i
    Debug.Print RowList(1).count, RowList(1)("Name")
End Sub

Answer 2

Используйте Option Explicit и объявите все свои переменные.

Строка 0 не является допустимой строкой, поэтому измените ее на l oop.

Option Explicit

Sub test()

Dim RowDict As Scripting.Dictionary
Dim RowList() As Variant
Dim TotalRow As Long
Dim SourceWS As Worksheet
Dim i As Long

Set SourceWS = ThisWorkbook.Sheets(1)

TotalRow = SourceWS.Cells(SourceWS.Rows.Count, 1).End(xlUp).Row
ReDim RowList(0)

For i = 1 To TotalRow
    Set RowDict = New Scripting.Dictionary
    RowDict.Add Key:="Name", Item:=SourceWS.Cells(i, 3)
    RowDict.Add Key:="ID", Item:=SourceWS.Cells(i, 4)
    RowDict.Add Key:="Device", Item:=SourceWS.Cells(i, 1)
    
    ReDim Preserve RowList(UBound(RowList) + 1)
    Set RowList(UBound(RowList)) = RowDict ' added SET because dictionaries are objects
Next

End Sub

или, если вы пытаюсь получить предметы:

For i = 1 To TotalRow
    Set RowDict = New Scripting.Dictionary
    RowDict.Add Key:="Name", Item:=SourceWS.Cells(i, 3)
    RowDict.Add Key:="ID", Item:=SourceWS.Cells(i, 4)
    RowDict.Add Key:="Device", Item:=SourceWS.Cells(i, 1)
    
    ReDim Preserve RowList(UBound(RowList) + 1)
    Debug.Print RowDict.Items(0) ' shows the item being added in the debug window
    RowList(UBound(RowList)) = RowDict.Items(0)
Next i