Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Two dimensional array as item of dictionary

I would like to populate a dictionary with several properties of an item. Example:

Sample data

I was thinking of having Item 1 and Item 2 as Dictionary keys with an array that would hold its properties. I would need to be able to separately access each property of an item so concatenating them as one string is not an option.

I'm thinking about something like the 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)
like image 979
newdimension Avatar asked Sep 27 '22 20:09

newdimension


2 Answers

You can also do what you originally proposed by using the Array function to create a Variant array. If your data structure is getting this elaborate, it's usually better to have a data model class as in @sous2817's answer. But this technique is useful for adhoc, throwaway code.

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
like image 107
Tmdean Avatar answered Oct 01 '22 18:10

Tmdean


Another approach - dictionary of dictionaries:

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

.

It adjusts dynamically to total number of rows and columns, so there is no maintenance needed

The benefit over collections is that you can check if keys exist or not

The slowest part is adding all items to dictionaries, but when done accessing the items is very fast

Note: Dictionaries cannot have duplicate Keys

.

Edit:

If you step through the code you'll be able to see the following objects:

DictionaryOfDictionaries

.

If you replace the MsgBox line with the following:

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 will 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 type

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

like image 20
paul bica Avatar answered Oct 01 '22 20:10

paul bica