Excel VBA: Print content of a dictionary of arrays to sheet-CodePudding

Good morning,
I’m trying to print out the content of a dictionary of arrays in one fell swoop to an Excel sheet. The dictionary structure may be something like this: dict(company_name) = employee, Where employee is an array of three values, e.g., name, surname, and age.
As long as the items are single value, I can easily print the dictionary with a statement like

Cells(1, 1).Resize(dict.Count, 1).Value2 = Application.Transpose(dict.Keys)
Cells(1, 2).Resize(dict.Count, 1).Value2 = Application.Transpose(dict.Items)

I cannot come up with a solution when I have array as item...
Do you know any ways to succeed?
Thank you for your time!

CodePudding user response：

You've got an error. dict.Keys - it's an array of the keys! You can't set the cell value as array You need to set the string variable and collect all keys in it

Dim str1 as String
Dim str2 as String
For i=1 to count 'qty of elements in dictionary
str1=str1 & dict.Keys()(i) 
str2=str2 & dict.Items()(i) 
Next i

Here is the link to the article about dictionaries

http://www.snb-vba.eu/VBA_Dictionary_en.html

CodePudding user response：

With a loop you can do something like this - should still be fast.

Sub DictOutput()
    
    Dim dict As Object, i As Long, r As Long, cols As Long, col As Long, arr, data, k
    Set dict = CreateObject("scripting.dictionary")
    
    'load some test data
    For i = 1 To 100
        dict.Add "Key_" & Format(i, "000"), Split("A,B,C,D", ",")
    Next i
    
    arr = dict.Items()(0)                        'get the first value
    cols = 1   (UBound(arr) - LBound(arr))       'number of items in array (assumed all the same size)
    ReDim data(1 To dict.Count, 1 To (1   cols)) 'size the output array
    r = 0
    
    For Each k In dict 'loop and fill the output array
        r = r   1
        data(r, 1) = k
        arr = dict(k)
        i = 2
        For col = LBound(arr) To UBound(arr) 'loop array and populate output row
            data(r, i) = arr(col)
            i = i   1
        Next col
    Next k
    
    'put the data on the sheet
    ActiveSheet.Range("A1").Resize(UBound(data, 1), UBound(data, 2)).Value = data
End Sub