Excel VBA 嵌套字典 - 访问项目

Question

Tim 是否可以从 clsMatrix 类中提取行键列表？像这样的东西...

Sub KEYS()
Dim KEY_LIST As Variant

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

End Sub

然后，我可以循环浏览表格以提取满足特定条件的数据子集。

蒂姆，你的代码对于一个二维矩阵来说效果很好，但我有 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

编辑:如果我想使用行/列标题快速访问二维数组，那么我倾向于不使用嵌套字典，而是使用两个不同的字典来键入进入每个维度(“行标签”字典和“列标签”字典)。

您可以将其包装在一个简单的类中:

'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