Excel vba вложенный словарь - доступ к элементам

Question

Тим можно извлечь список ключей строк из класса clsMatrix? что-то вроде этого ...

Sub KEYS() 
Dim KEY_LIST As Variant 

KEY_LIST = TABLES("UDLY").dR.KEYS 

End Sub 

Затем я могу пройти через таблицу, чтобы извлечь подмножество данных, которые отвечают определенным критериям.

Тим, ваш код хорошо работает для одной 2D-матрицы, но у меня есть 5 таблиц для ссылки на работу проекта. Я пытался использовать if ... then else, но это неуклюже и не работает. Второй проход, который ищет данные из таблицы BOOK, не может найти ссылки на словаря row и col. Можете ли вы предложить лучший метод? Спасибо за вашу помощь.

Option Explicit 
Private dR, dC 
Private m_arr, UDLY, BOOK 
' 

Sub Init(TABLE As String) 

    Dim i As Long 
Dim RNGE As Range 
Dim DATA As Variant 
Dim arr As Variant 

If TABLE = "UDLY" Then Set RNGE = Worksheets("SETTINGS").Range("UDLY_TABLE") 
If TABLE = "BOOK" Then Set RNGE = Worksheets("BOOK").Range("BOOK_TABLE") 

    arr = RNGE.Value 

    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 
    If TABLE = "UDLY" Then UDLY = arr 
    If TABLE = "BOOK" Then BOOK = arr 
End Sub 

Function GetValue(TABLE, rowKey, colKey) 


    If dR.Exists(rowKey) And dC.Exists(colKey) Then 
'  GetValue = m_arr(dR(rowKey), dC(colKey)) 

     If TABLE = "UDLY" Then GetValue = UDLY(dR(rowKey), dC(colKey)) 
     If TABLE = "BOOK" Then GetValue = BOOK(dR(rowKey), dC(colKey)) 
    Else 
     GetValue = 999 '"" 'or raise an error... 
    End If 
End Function 

«========================================== =================

Option Explicit 

Sub Tester() 
    Dim m As New clsMatrix 

' m.Init (ActiveSheet.Range("b40").CurrentRegion.Value) 
' m.Init (Worksheets("settings").Range("udly_table")) 
    m.Init ("UDLY") 
    Debug.Print m.GetValue("UDLY", "APZ4-FUT", "SPOT_OFFLINE") 

    m.Init ("BOOK") 
    Debug.Print m.GetValue("BOOK", "2.04", "STRIKE") 
End Sub 

Answer 1

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:, хочу ли я иметь дело с быстрым доступом массива 2-D, используя заголовки строк/столбцов, то Я был бы склонен не использовать вложенные словари, но использовать два разных словаря для ключа в каждом измерении (словарь ярлыков строк и «метка столбца»).

Вы можете обернуть это в простом классе: использование

'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 

Примера: если предположить A1 является верхней левой ячейкой в ​​прямоугольной области, где первая строка заголовки столбцов («col1» до «colx «) и первый столбец строки заголовков (» Row1" к „Rowy“) -

EDIT2: внесены некоторые изменения, чтобы показать, как управлять несколькими различными таблицами (без внесения изменений в код класса)

'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