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

时间:2014-01-14 12:07:42

标签: object excel-vba iterator iteration vba

我正试图找出一种方法来迭代(字典)其他自定义对象中包含的自定义对象,而不必每次都使用'set'。

我的目标是能够直接写出来:

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

但上面给出了object required错误。但是,我想避免像

这样的事情
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

class object 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

1 个答案:

答案 0 :(得分:1)

我稍微修改了您的代码(Property Get GetMembers()cFamily):

Public Property Get GetMembers() As cPerson()
    Dim tmpArray() As cPerson, i As Integer
    ReDim tmpArray(pFamily.Count - 1)

    For i = 0 To pFamily.Count - 1
        Set tmpArray(i) = pFamily.Items()(i)
    Next
    GetMembers = tmpArray
End Property

现在您可以使用它,如下所示:

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


您的Property Get GetMembers()错了,因为:

1)你已经定义了错误的数组dimmension:ReDim tmpArray(pFamily.Count)表示tmpArray具有dimmension 0 To pFamily.Count。您需要使用ie ReDim tmpArray(1 To pFamily.Count)

2)你没有增加i - 它总是等于1.