Two-dimensional array as a dictionary element

Question

I would like to populate a dictionary with several element properties. Example:

I thought that as Dictionarykeys with parameters there arraywill be Item 1 and Item 2 elements that will contain their properties. I would need to be able to separately access each property of an element, thus concatenating them, since one line is not an option.

I am thinking of something like below pseudo code :

    With Workbooks("testing macro").Sheets(test).Range("D7:G8")

     For i = 1 To .Rows.count

        items_dict.Add Key:=.Cells(i, 1).Value, _
 Item:= array(i,1)= .cells(i,2).value array(i,2)=.cells(i,3).value array(i,3).cells(i,4)

Answer 1

Here is a simple example of using a class and a collection (mostly modified from the examples here :

( - Employee):

Option Explicit

Private pName As String
Private pAddress As String
Private pSalary As Double

Public Property Get Name() As String
    Name = pName
End Property
Public Property Let Name(Value As String)
    pName = Value
End Property
Public Property Get Address() As String
    Address = pAddress
End Property
Public Property Let Address(Value As String)
    pAddress = Value
End Property
Public Property Get Salary() As Double
    Salary = pSalary
End Property
Public Property Let Salary(Value As Double)
    pSalary = Value
End Property

:

Option Explicit

Sub test()
    Dim counter As Integer

    Dim Employees As Collection
    Dim Emp As Employee

    Dim currentEmployee As Employee


    Set Employees = New Collection

    For counter = 1 To 10
        Set Emp = New Employee

        Emp.Name = "Employee " & counter
        Emp.Address = "Address " & counter
        Emp.Salary = counter * 1000

        Employees.Add Emp, Emp.Name

    Next counter

    Set currentEmployee = Employees.Item("Employee 1")


    Debug.Print (currentEmployee.Address)

End Sub

, :

Employees.Add Emp, Emp.Name

.

Answer 2

, , Array Variant. , , @sous2817. adhoc, throwaway.

Dim r As Range

For Each r In ['[testing macro.xlsx]test'!D7:G8].Rows
    ItemsDict.Add r.Cells(1).Value, Array( _
        r.Cells(2).Value, _
        r.Cells(3).Value, _
        r.Cells(4).Value)
Next

Answer 3

- :

Option Explicit

Public Sub nestedList()
    Dim ws As Worksheet, i As Long, j As Long, x As Variant, y As Variant, z As Variant
    Dim itms As Dictionary, subItms As Dictionary   'ref to "Microsoft Scripting Runtime"

    Set ws = Worksheets("Sheet1")
    Set itms = New Dictionary

    For i = 2 To ws.UsedRange.Rows.Count

        Set subItms = New Dictionary         '<-- this should pick up a new dictionary

        For j = 2 To ws.UsedRange.Columns.Count

            '           Key: "Property 1",          Item: "A"
            subItms.Add Key:=ws.Cells(1, j).Value2, Item:=ws.Cells(i, j).Value2

        Next

        '        Key: "Item 1",              Item: subItms
        itms.Add Key:=ws.Cells(i, 1).Value2, Item:=subItms

        Set subItms = Nothing                '<-- releasing previous object

    Next
    MsgBox itms("Item 3")("Property 3")      'itms(ws.Cells(3, 1))(ws.Cells(1, 3)) = "I"
End Sub

.

,

, ,

- ,

:

.

Edit

If you go through the code, you can see the following objects:

.

If you replace the MsgBox line as follows:

For Each x In itms.Keys
    For Each y In itms(x)
        If InStr(y, 1) > 0 Then
            Debug.Print vbNullString
            Debug.Print x & " ---> Key: '" & y & "' -> Item: '" & itms(x)(y) & "'"
        Else
            Debug.Print vbTab & vbTab & " -> Key: '" & y & "' -> Item: '" & itms(x)(y) & "'"
        End If
    Next
Next

You'll get:

Item 1 ---> Key: 'Property 1' -> Item: 'A'
         -> Key: 'Property 2' -> Item: 'B'
         -> Key: 'Property 3' -> Item: 'C'

Item 2 ---> Key: 'Property 1' -> Item: 'D'
         -> Key: 'Property 2' -> Item: 'E'
         -> Key: 'Property 3' -> Item: 'F'

Item 3 ---> Key: 'Property 1' -> Item: 'G'
         -> Key: 'Property 2' -> Item: 'H'
         -> Key: 'Property 3' -> Item: 'I'

or enter

For Each x In itms.Keys: For Each y in itms(x): Debug.Print x & " -> " & y & " -> " & itms(x)(y): Next: Next

in the debug window