Как получить доступ к ключам вложенного словаря?

Question

У меня есть некоторые данные, которые я пытаюсь сохранить во вложенном словаре.

Затем я хотел бы иметь возможность перебирать этот вложенный словарь и каким-то образом выводить данные.(В конечном счете, в ячейках, но сейчас я просто пытаюсь получить «наиболее вложенные» ключи).

Данные настроены так:

Recipient   Company InfoA   InfoB   InfoC   InfoD
John        CompanyA          123       
Jacob       CompanyB    322           44    
Smithy      CompanyC                
Smitherson  CompanyD     11    22            555

Идея состоит в том,циклически проходить по каждой строке с данными, и если в столбце «Инфо []» есть числа, сохраните их в соответствии с информацией / компанией, а затем «Получатель».

Вот «визуальный» способ получения информациисохранено:

John            
    CompanyA        
        InfoB   123
Jacob           
    CompanyB        
        InfoA   322
        InfoC   44
Smitherson          
    CompanyD        
        InfoA   11
        InfoB   22
        InfoD   555

Теперь, используя подпрограмму traversedictionary(), которую я нашел на SE, я смог успешно перебрать ключи и получить данные - однако , и этомой вопрос, я не могу получить часть "Информация" окончательных данных.

Вот VBA для построения диктанта:

Sub create_dicts()
Dim final As Dictionary
Dim mini As Dictionary
Dim tmp As Dictionary

Dim dataRng As Range, cel As Range, iRow As Range
Set dataRng = Range("C2:F5")

Set final = New Dictionary

For Each iRow In dataRng.Rows
    Set mini = New Dictionary
    If WorksheetFunction.Sum(iRow) <> 0 Then
        Set tmp = New Dictionary
        For Each cel In iRow.Cells
            If cel.Value <> 0 Then
                ' Add that cell's number to a dictionary, with the Header as Key
                tmp.Add Cells(1, cel.Column), cel.Value
            End If
        Next cel
        ' Now that we've checked all cells in that row, add the resulting info to a dict for that Company
        mini.Add Cells(iRow.Row, 2), tmp
        ' Now that we have all info for that row/company, put in a dictionary
        ' with the RECIPIENT as the key
        final.Add Cells(iRow.Row, 1), mini
    End If
Next iRow
TraverseDictionary final
End Sub

Как я перебираю это:

Private Sub TraverseDictionary(d As Dictionary)
Dim key As Variant
Dim depth As Long
Dim i As Long
'https://codereview.stackexchange.com/questions/63353/
    For Each key In d.Keys
        If VarType(d(key)) = 9 Then
            Debug.Print "KEY: " & key
            depth = depth + 1
            TraverseDictionary d(key)
        Else
            Debug.Print "ITEM: " & d(key)
        End If
        i = i + 1
    Next
End Sub

Вывод:

KEY: John
KEY: CompanyA
ITEM: 123
KEY: Jacob
KEY: CompanyB
ITEM: 322
ITEM: 44
KEY: Smitherson
KEY: CompanyD
ITEM: 11
ITEM: 22
ITEM: 555

Я ожидал:

KEY: John
KEY: CompanyA
KEY: InfoB
ITEM: 123
...

Итак, как вы можете видеть, я могу получить Получателя,затем Компания, но не может получить часть "Информация", чтобы показать.Что я пропускаю / пропускаю?

Answer 1

Попробуйте вместо этого:

Private Sub TraverseDictionary(d As Dictionary, Optional ByVal depth As Long = 1)
Dim key As Variant
Dim i As Long

    For Each key In d.Keys
        If VarType(d(key)) = vbObject Then
            Debug.Print String(depth * 3, "-") & "KEY: " & key & " (dictionary)"
            TraverseDictionary d(key), depth + 1
        Else
            Debug.Print String(depth * 3, "-") & "ITEM: " & key & ": " & d(key)
        End If
        i = i + 1
    Next
End Sub

Вывод:

---KEY: John
------KEY: CompanyA
---------ITEM: InfoB: 123
---KEY: Jacob
------KEY: CompanyB
---------ITEM: InfoA: 322
---------ITEM: InfoC: 44
---KEY: Smitherson
------KEY: CompanyD
---------ITEM: InfoA: 11
---------ITEM: InfoB: 22
---------ITEM: InfoD: 555