Object 迭代自定义对象类Excel VBA的更好方法

我正试图找到一种方法来迭代（字典）中包含的自定义对象，而不必每次都使用“set”

我的目标是能够笔直地写：

For Each Person In Family.GetMembers
    test= Person.Age
Next Person

但是上面给出了一个

所需对象

错误。然而，我想避免类似的事情

for each name in family.keys
   set Person = Family.GetMember(name) 
   test= Person.Age
next name

类对象cperson

Option Explicit
Private pName As String
Private pAge As Integer
Public Property Let name(name As String):
    pName = name
End Property
Public Property Get name() As String
    name = pName
End Property
Public Property Let Age(Age As Integer):
    pAge = Age
End Property
Public Property Get Age() As Integer
    Age = pAge
End Property

类对象cfamily

Option Explicit
Private pFamily As Object
Private pName As String
Private Sub Class_Initialize()
    Set pFamily = CreateObject("Scripting.Dictionary")
End Sub
Private Sub Class_Terminate()
    Set pFamily = Nothing
End Sub
Public Sub Add(Person As CPerson)
    If pFamily.exists(Person.name) Then
        pFamily.Remove Person.name
        pFamily.Add Person.name, Person
    Else
        pFamily.Add Person.name, Person
    End If
End Sub
Public Property Get GetMember(name As Variant) As CPerson:
    Set GetMember = pFamily(name)
End Property
Public Property Let name(name As String):
    pName = name
End Property
Public Property Get name() As String
    name = pName
End Property
Public Property Get GetMembers() As Variant
    Dim tmpArray() As Variant, Person As CPerson, i As Integer, name As Variant
    ReDim tmpArray(pFamily.Count)
    i = 1
    For Each name In pFamily.keys
        Set Person = pFamily(name)
        Set tmpArray(i) = Person
        i=i+1
    Next name
    GetMembers = tmpArray
End Property

---

我稍微修改了您的代码（

cf家族的
Property Get GetMembers（）
）：

现在您可以按如下方式使用它：

Sub Test()
    Dim family As New cFamily

    Dim p1 As New cPerson
    Dim p2 As New cPerson
    Dim p3 As New cPerson

    Dim p as Variant

    p1.name = "name1"
    p2.name = "name2"
    p3.name = "name3"

    family.Add p1
    family.Add p2
    family.Add p3

    For Each p In family.GetMembers
        MsgBox p.name
    Next
End Sub



您的
属性Get GetMembers（）
错误，因为：

1） 您定义了错误的数组DIMMENTION:
ReDim tmpArray（pFamily.Count）
表示
tmpArray
对pFamily.Count的DIMMENTION
0。您需要使用，即
ReDim-tmpArray（1到pffamily.Count）

2） 你没有递增
i
——它总是等于1
 甜蜜的。。。坦白地说，我根本没料到这种方法会奏效（也许更像这样）。但那正是我想要的！
Sub Test()
    Dim family As New cFamily

    Dim p1 As New cPerson
    Dim p2 As New cPerson
    Dim p3 As New cPerson

    Dim p as Variant

    p1.name = "name1"
    p2.name = "name2"
    p3.name = "name3"

    family.Add p1
    family.Add p2
    family.Add p3

    For Each p In family.GetMembers
        MsgBox p.name
    Next
End Sub