打印集合中的字典名称

Question

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

我的代码如下：

首先，创建单独的字典并向其中添加数据：

Dim Cows, Dogs, Goats As Object

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

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

完成此操作后，创建字典集合并开始循环查看每个字典的名称（结果应在即时窗口中为我们提供“牛、狗、山羊”）：

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

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

您可以使用“包装器”类来模拟您想要的内容，以允许名称与特定字典相关联。

下面的示例实现了一个简单的包装类，它允许设置名称但不能更改名称，并通过 Host 属性公开 scripting.dictionary。

类动物类型

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（实际上是一个Collectionkey）添加到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 属性，您可以使用能够包装名称的类，以便使用对象和其名称：

1. 复制一个类中的下一个代码并将其命名为“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

1. 在标准模块中复制下一个代码：

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