打印集合中字典的名称

Question

我创建了一个包含多个词典的集合。当我尝试遍历集合以打印字典的名称时，我收到以下错误消息：450 - 参数数量错误或属性参数无效。

我的代码如下：

首先，创建个人词典并向其中添加数据：

Dim Cows, Dogs, Goats As Object

Set Cows = CreateObject("scripting.dictionary")
Set Dogs = CreateObject("scripting.dictionary")
Set Goats = CreateObject("scripting.dictionary")

[...用数据加载词典...]

一旦完成，创建字典集合并开始循环查看每个字典的名称（结果应该立即给我们“Cows, Dogs, Goats”window） :

Dim TotalAnimals As New Collection

    TotalAnimals.Add Cows
    TotalAnimals.Add Dogs
    TotalAnimals.Add Swans

问题出在这里：

Dim AnimalType As Variant
        For Each AnimalType In TotalAnimals
        Debug.Print AnimalType
Next AnimalType

任何帮助将不胜感激！！

Answer 1

您要实现的目标称为 'Reflection'。不幸的是，VBA 语言没有反射，所以你不能直接实现你想要的。

您可以使用 'wrapper' class 来模拟您想要的内容，以允许名称与特定词典相关联。

下面的示例实现了一个简单的包装器 class，它允许设置但不能更改名称，并通过主机属性.[=14= 公开 scripting.dictionary ]

Class动物类型

Option Explicit

Private Type Properties

    Name                    As String
    Host                    As Scripting.Dictionary

End Type

Private p                   As Properties


Private Sub Class_Initialize()
    Set p.Host = New Scripting.Dictionary
End Sub

Public Property Get Name() As String
    Name = p.Name
End Property

Public Property Let Name(ByVal ipName As String)

    If VBA.Len(p.Name) = 0 Then
    
        p.Name = ipName
        
    Else
    
        Err.Raise 17 ' Can't perform the requested action
        
    End If
    
End Property


Public Property Get Host() As Scripting.Dictionary
    Set Host = p.Host
End Property

因此

Dim Cows, Dogs, Goats As Object

Set Cows = CreateObject("scripting.dictionary")
Set Dogs = CreateObject("scripting.dictionary")
Set Goats = CreateObject("scripting.dictionary")

会变成

2020 年 1 月 30 日编辑以更正以下代码

Dim Cows as AnimalType
Dim Dogs as AnimalType
Dim Goats as AnimalType


Set Cows = new AnimalType
Cows.name="Cows"
Set Dogs = New AnimalType
Dogs.Name="Dogs"
Set Goats = New AnimalType
Goats.Name="Goats"

然后

Dim myAnimalType As Variant
For Each myAnimalType In TotalAnimals
    Debug.Print myAnimalType.Name
Next

Answer 2

请按以下方式调整您的代码。你可以给字典一个Name（实际上是一个Collection key）当把它添加到Collection:

Sub testDictNameInCollection()
     Dim Cows As Object, Dogs As Object, Goats As Object
     Dim TotalAnimals As New Collection, i As Long, arrK
     
     Set Cows = CreateObject("scripting.dictionary")
     Set Dogs = CreateObject("scripting.dictionary")
     Set Goats = CreateObject("scripting.dictionary")
     
     'load here the dictionaries...

     TotalAnimals.Add Cows, "Cows"
     TotalAnimals.Add Dogs, "Dogs"
     TotalAnimals.Add Goats, "Goats"
     arrK = Array("Cows", "Dogs", "Goats")
     
     For i = 0 To UBound(arrK)
        Debug.Print TotalAnimals.item(arrK(i)).count
     Next i
     TotalAnimals.item("Cows").Add "Cow 1 ", "a lot of milk"
     Debug.Print TotalAnimals("Cows").Items()(TotalAnimals("Cows").count - 1) 'last item of the "Cow" dictionary
End Sub

由于 Scripting.Dictionary 不公开 Name 属性，您可以使用 class 能够包装名称，以便使用对象和它的名字：

复制 class 中的下一个代码并将其命名为“AnimalClass”：

Option Explicit

Private dictName As String
Private dict As Object

Private Sub Class_Initialize()
   Set dict = CreateObject("Scripting.Dictionary")
End Sub

Public Property Get Name() As String
    Name = dictName
End Property

Public Property Let obj(dic As Object)
    Set dict = dic
End Property

Public Property Let Name(strName As String)
    dictName = strName
End Property

Public Property Get obj() As Object
    Set obj = dict
End Property

复制标准模块中的下一个代码：

Sub testDictionaryName()
  Dim Cows As Object, Dogs As Object, Goats As Object, i As Long
  Dim TotalAnimals As New Collection, animT As AnimalClass
  
 Set animT = New AnimalClass
   Set Cows = CreateObject("scripting.dictionary")
   For i = 1 To 2: Cows(i) = "Cows " & i: Next i 'load the dictionary
   animT.obj = Cows: animT.Name = "Cows"
   TotalAnimals.Add animT  'add the class in Collection
   
 Set animT = New AnimalClass
   Set Dogs = CreateObject("scripting.dictionary")
   For i = 1 To 3: Dogs(i) = "Dog " & i: Next i
   animT.obj = Dogs: animT.Name = "Dogs"
   TotalAnimals.Add animT
 
 Set animT = New AnimalClass
   Set Goats = CreateObject("scripting.dictionary")
   For i = 1 To 4: Goats(i) = "Goat " & i: Next i
   animT.obj = Goats: animT.Name = "Goats"
   TotalAnimals.Add animT
  
 Dim myAnimalType As Variant
 For Each myAnimalType In TotalAnimals
     Debug.Print myAnimalType.Name, myAnimalType.obj.count, myAnimalType.obj.Items()(myAnimalType.obj.count - 1)
 Next
End Sub

打印集合中字典的名称

Printing the Name of Dictionaries inside a Collection

collections

vba

dictionary