Excel vba 嵌套字典 - 访问项目
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/27180646/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel vba nested dictionary - accessing items
提问by Zeus
Tim is it possible to extract a list of row keys from the clsMatrix class? something like this...
Tim 是否可以从 clsMatrix 类中提取行键列表？像这样的东西......
Sub KEYS()
Dim KEY_LIST As Variant
KEY_LIST = TABLES("UDLY").dR.KEYS
End Sub
I can then cycle through a table to extract a subset of data which meet a certain criteria.
然后我可以循环遍历一个表来提取满足特定条件的数据子集。
Tim, your code works well for one 2D matrix, but I have 5 tables to reference for the project to work. I tried using if...then else statements, but it's clumsy and doesn't work - the second pass looking for data from the BOOK table can't find the row and col dictionary references. Can you suggest a better method? Thanks for your help.
蒂姆，您的代码适用于一个 2D 矩阵，但我有 5 个表可供项目参考。我尝试使用 if...then else 语句，但它笨拙且不起作用 - 从 BOOK 表中查找数据的第二遍找不到行和列字典引用。你能提出更好的方法吗？谢谢你的帮助。
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
回答by Tim Williams
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") -
用法示例：假设 A1 是矩形范围内的左上角单元格，其中第一行是列标题（“col1”到“colx”），第一列是行标题（“row1”到“rowy”）-
EDIT2: made some changes to show how to manage multiple different tables (with no changes to the class code)
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
