如何在Excel VBA中将对象集合作为其他对象的属性

时间:2015-12-12 12:51:56

标签: excel vba excel-vba

我不知道如何在excel vba中实现以下代码片段。我想要做的是从u.assignSubjects方法为User对象分配主题集合 [班主题]

Private sName As String
Public Property Get Name() As String
    Name = sName
End Property
Public Property Let Name(n As String)
    sName = n
End Property

[类用户]

Private sName As String
Private sSubjects As Collection

Public Property Get Name() As String
    Name = sName
End Property
Public Property Let Name(n As String)
    sName = n
End Property
Public Property Get Subjects() As Collection
    Subjects = sSubjects
End Property
Public Property Let Subjects(s As Collection)
    sSubjects = s
End Property
Public Sub assignSubjects()
    Dim s1 As clsSubject
    Dim s2 As clsSubject
    Set s1 = New clsSubject
    Set s2 = New clsSubject

    s1.Name = "English"
    s2.Name = "Math"

    Set sSubjects = New Collection
    sSubjects.Add s1, "subject1"

    Set sSubjects = New Collection
    sSubjects.Add s2, "subject2"
End Sub

[实施]

Sub run()
    Dim u As clsUser
    Set u = New clsUser
    u.assignSubjects
    For Each a In u.Subjects
        Debug.Print u.Subjects(a).Name
    Next
End Sub

请帮帮我

1 个答案:

答案 0 :(得分:2)

由于您的sSubjectsCollection个对象,因此您必须使用Set为其指定内容。

此外,您不应多次创建New Collection。相反,你可以用Private Sub Class_Initialize()来做到这一点。

clsSubject

Private sName As String

Public Property Get Name() As String
    Name = sName
End Property
Public Property Let Name(n As String)
    sName = n
End Property

clsUser

Private sName As String
Private sSubjects As Collection

Public Property Get Name() As String
    Name = sName
End Property
Public Property Let Name(n As String)
    sName = n
End Property
Public Property Get Subjects() As Collection
    Set Subjects = sSubjects
End Property
Public Property Set Subjects(s As Collection)
    Set sSubjects = s
End Property
Private Sub Class_Initialize()
    Set Me.Subjects = New Collection
End Sub
Public Sub assignSubjects()
    Dim s1 As clsSubject
    Dim s2 As clsSubject
    Set s1 = New clsSubject
    Set s2 = New clsSubject

    s1.Name = "English"
    s2.Name = "Math"

    Me.Subjects.Add s1, "subject1"

    Me.Subjects.Add s2, "subject2"
End Sub

Module

Sub run()
    Dim u As clsUser
    Set u = New clsUser
    u.assignSubjects

    Dim s As clsSubject
    Set s = New clsSubject
    s.Name = "German"

    u.Subjects.Add s

    For Each a In u.Subjects
        Debug.Print a.Name
    Next
End Sub