Question

我想填充一个包含项目的几个属性的字典。例如：

我在考虑将第1项和第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

这是一个使用类和集合的简单示例（基本上是根据示例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

然后您可以使用它直接从中循环而不循环。

Answer 2

您还可以使用Array函数创建Variant数组，从而完成最初建议的操作。如果你的数据结构很复杂，那么拥有数据模型类通常比在@ sous2817的答案中更好。但是这种技术对于adhoc，一次性代码很有用。

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

另一种方法 - 字典词典：

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
调试窗口中的

二维数组作为字典项

3 个答案: