Excel vba nested dictionary - accessing items

不问归期 提交于 2019-12-01 17:57:19
Sub DICT_OF_DICT()

    Dim d1, d2

    Set d1 = CreateObject("Scripting.Dictionary")
    Set d2 = CreateObject("Scripting.Dictionary")

    d1.Add "BPH", "Hello"
    d2.Add "Shaun", d1

    Debug.Print d2("Shaun").Item("BPH")

End Sub

EDIT: if I wanted to deal with quickly accessing a 2-D array using row/column headers then I'd be inclined not to use nested dictionaries, but to use two distinct dictionaries to key into each dimension (a "row label" dictionary and a "column label" one).

You can wrap this up in a simple class:

'Class module: clsMatrix
Option Explicit

Private dR, dC
Private m_arr

Sub Init(arr)

    Dim i As Long

    Set dR = CreateObject("Scripting.Dictionary")
    Set dC = CreateObject("Scripting.Dictionary")

    'add the row keys and positions
    For i = LBound(arr, 1) + 1 To UBound(arr, 1)
        dR.Add arr(i, 1), i
    Next i
    'add the column keys and positions
    For i = LBound(arr, 2) + 1 To UBound(arr, 2)
        dC.Add arr(1, i), i
    Next i

    m_arr = arr
End Sub

Function GetValue(rowKey, colKey)
    If dR.Exists(rowKey) And dC.Exists(colKey) Then
        GetValue = m_arr(dR(rowKey), dC(colKey))
    Else
        GetValue = "" 'or raise an error...
    End If
End Function

'EDIT: added functions to return row/column keys
'   return a zero-based array
Function RowKeys()
    RowKeys = dR.Keys
End Function

Function ColumnKeys()
    ColumnKeys = dC.Keys
End Function

Example usage: assuming A1 is the top-left cell in a rectangular range where the first row is column headers ("col1" to "colx") and the first column is row headers ("row1" to "rowy") -

EDIT2: made some changes to show how to manage multiple different tables (with no changes to the class code)

'Regular module
Sub Tester()

    Dim tables As Object, k
    Set tables = CreateObject("Scripting.Dictionary")

    tables.Add "Table1", New clsMatrix
    tables("Table1").Init ActiveSheet.Range("A1").CurrentRegion.Value

    tables.Add "Table2", New clsMatrix
    tables("Table2").Init ActiveSheet.Range("H1").CurrentRegion.Value


    Debug.Print tables("Table1").GetValue("Row1", "Col3")
    Debug.Print tables("Table2").GetValue("R1", "C3")

    k = tables("Table1").RowKeys()
    Debug.Print Join(k, ", ")

End Sub
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!