二维数组作为字典项

Question

我想用一个项目的几个属性填充字典。示例：

我正在考虑将 Item 1 和 Item 2 作为 Dictionary 键，并使用 array 来保存其属性。 我需要能够单独访问项目的每个属性，因此将它们连接为一个字符串不是一种选择。

我正在考虑类似下面的伪代码：

    With Workbooks("testing macro").Sheets(test).Range("D7:G8")

     For i = 1 To .Rows.count

        items_dict.Add Key:=.Cells(i, 1).Value, _
 Item:= array(i,1)= .cells(i,2).value array(i,2)=.cells(i,3).value array(i,3).cells(i,4)

Answer 1

另一种方法 - 字典词典：

Option Explicit

Public Sub nestedList()
    Dim ws As Worksheet, i As Long, j As Long, x As Variant, y As Variant, z As Variant
    Dim itms As Dictionary, subItms As Dictionary   'ref to "Microsoft Scripting Runtime"

    Set ws = Worksheets("Sheet1")
    Set itms = New Dictionary

    For i = 2 To ws.UsedRange.Rows.Count

        Set subItms = New Dictionary         '<-- this should pick up a new dictionary

        For j = 2 To ws.UsedRange.Columns.Count

            '           Key: "Property 1",          Item: "A"
            subItms.Add Key:=ws.Cells(1, j).Value2, Item:=ws.Cells(i, j).Value2

        Next

        '        Key: "Item 1",              Item: subItms
        itms.Add Key:=ws.Cells(i, 1).Value2, Item:=subItms

        Set subItms = Nothing                '<-- releasing previous object

    Next
    MsgBox itms("Item 3")("Property 3")      'itms(ws.Cells(3, 1))(ws.Cells(1, 3)) = "I"
End Sub

.

它会根据行数和列数动态调整，因此无需维护

集合的好处是你可以检查键是否存在

最慢的部分是将所有项目添加到字典中，但完成后访问项目非常快

注意：字典不能有重复的键

.

编辑：

如果您单步执行代码，您将能够看到以下对象：

.

如果您将 MsgBox 行替换为以下内容：

For Each x In itms.Keys
    For Each y In itms(x)
        If InStr(y, 1) > 0 Then
            Debug.Print vbNullString
            Debug.Print x & " ---> Key: '" & y & "' -> Item: '" & itms(x)(y) & "'"
        Else
            Debug.Print vbTab & vbTab & " -> Key: '" & y & "' -> Item: '" & itms(x)(y) & "'"
        End If
    Next
Next

你会得到：

Item 1 ---> Key: 'Property 1' -> Item: 'A'
         -> Key: 'Property 2' -> Item: 'B'
         -> Key: 'Property 3' -> Item: 'C'

Item 2 ---> Key: 'Property 1' -> Item: 'D'
         -> Key: 'Property 2' -> Item: 'E'
         -> Key: 'Property 3' -> Item: 'F'

Item 3 ---> Key: 'Property 1' -> Item: 'G'
         -> Key: 'Property 2' -> Item: 'H'
         -> Key: 'Property 3' -> Item: 'I'

或输入

For Each x In itms.Keys: For Each y in itms(x): Debug.Print x & " -> " & y & " -> " & itms(x)(y): Next: Next

在调试窗口中

Answer 2

您也可以使用Array 函数创建一个Variant 数组来执行您最初建议的操作。如果您的数据结构变得如此复杂，那么在@sous2817 的答案中拥有一个数据模型类通常会更好。但是这种技术对于临时的、一次性的代码很有用。

Dim r As Range

For Each r In ['[testing macro.xlsx]test'!D7:G8].Rows
    ItemsDict.Add r.Cells(1).Value, Array( _
        r.Cells(2).Value, _
        r.Cells(3).Value, _
        r.Cells(4).Value)
Next

Answer 3

这里是一个使用类和集合的简单示例（基本上从示例here修改：

类很简单（类名是Employee）：

Option Explicit

Private pName As String
Private pAddress As String
Private pSalary As Double

Public Property Get Name() As String
    Name = pName
End Property
Public Property Let Name(Value As String)
    pName = Value
End Property
Public Property Get Address() As String
    Address = pAddress
End Property
Public Property Let Address(Value As String)
    pAddress = Value
End Property
Public Property Get Salary() As Double
    Salary = pSalary
End Property
Public Property Let Salary(Value As Double)
    pSalary = Value
End Property

这里是测试代码：

Option Explicit

Sub test()
    Dim counter As Integer

    Dim Employees As Collection
    Dim Emp As Employee

    Dim currentEmployee As Employee


    Set Employees = New Collection

    For counter = 1 To 10
        Set Emp = New Employee

        Emp.Name = "Employee " & counter
        Emp.Address = "Address " & counter
        Emp.Salary = counter * 1000

        Employees.Add Emp, Emp.Name

    Next counter

    Set currentEmployee = Employees.Item("Employee 1")


    Debug.Print (currentEmployee.Address)

End Sub

如您所见，我正在向我的班级添加项目，指定一个键：

Employees.Add Emp, Emp.Name

然后您可以使用它直接从中提取而无需循环。