Arrays 作为字典项的二维数组

Arrays 作为字典项的二维数组,arrays,excel,dictionary,vba,Arrays,Excel,Dictionary,Vba,我想用一个项目的几个属性填充字典。例如: 我正在考虑将项1和项2作为字典键,并使用数组保存其属性。 我需要能够单独访问一个项目的每个属性,因此将它们作为一个字符串连接不是一个选项 我在考虑下面的伪代码: With Workbooks("testing macro").Sheets(test).Range("D7:G8") For i = 1 To .Rows.count items_dict.Add Key:=.Cells(i, 1).Value, _

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

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

我在考虑下面的伪代码:

    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)

下面是一个使用类和集合的简单示例(基本上根据示例进行了修改:

类非常简单(类名为Employee):

以下是测试代码:

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

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

您也可以使用
数组
函数创建一个变体数组。如果您的数据结构变得如此复杂,通常最好使用@sous2817的答案中的数据模型类。但是这种技术对于adhoc非常有用,throwaway代码

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

另一种方法-词典词典:

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
您将获得:

Item 1-->Key:'Property 1'->Item:'A'
->键:“属性2”->项:“B”
->键:“属性3”->项:“C”
项目2->键:“属性1”->项目:“D”
->键:“属性2”->项:“E”
->键:“属性3”->项:“F”
项目3--->键:“属性1”->项目:“G”
->键:“属性2”->项:“H”
->键:'Property 3'->项:'I'
或类型

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

在调试窗口中

问题是什么?为什么不使用类和集合?我定义字典的方式不是有效的代码。只是编写它来描述我认为需要发生的事情。我不使用集合,因为我需要字典的关键功能来有选择地提取数据。即,能够获取有关特定字典的信息em我想到了。你可以用集合来做。我将发布一个示例…这是一个很好的方法。当我们移动行时,数组发生了什么?我们基本上是在做
数组(Value1,Value2,Value3)
,数据刚刚被覆盖吗?当我们移动到第二行时会发生什么?另外,VBA如何知道设置
数组[1]=“Value1”
而不调用
数组[1]
?数组(1,2,3)创建一个包含元素1,2,3的新数组。每次通过for循环,数组()调用,因此将为每行创建一个新数组。您将为dict类Debug.Print ITESDICT(“键”)(0)(以获取第一个元素)。不确定最后一个问题是什么。谢谢,我感谢您回来并理解其他方法。很多人在获得一些工作代码后都会跑掉。
subItms.Add Key:=ws.Cells(1,j).Value2,项:=ws.Cells(i,j).Value2
第一个循环设置
属性1
=>
A
属性2
=>
B
属性3
=>
C
。但是,第二个循环设置
属性1
D
属性2
属性3
。这是什么意思这些属性是否属于项2而不是项1?嵌套的2个For循环区分了字典:外部循环创建主字典,而内部循环创建多个子字典。显示属于主字典的属性的行是
itms。Add Key:=…
(对象名为“itms”)是顶级字典)。我将添加结构的图像以使其清晰。在我看来,在完成项目1的循环后,您将返回到设置sdict(“属性1”)当它已经设置好时。我还收到一个键已在使用错误,代码模仿了您的逻辑。编辑:似乎您没有创建多个子字典。我复制粘贴了您的代码,这一次也是如此。我仍然收到错误“此键已与此集合的一个元素关联”。这与我对其运行方式的理解一致,您在第二个循环中使用相同的字典,因此不能使用相同的
键,即属性1、2和3。您在循环中使用
Set subItms=New dictionary
重置字典!这是我的问题。我没有意识到这是在循环重置字典并允许我们在全新的字典上使用相同的
键。
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
For Each x In itms.Keys: For Each y in itms(x): Debug.Print x & " -> " & y & " -> " & itms(x)(y): Next: Next