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

我不知道如何在Excel VBA中实现以下代码片段。 我想要做的是从u.assignSubjects方法分配用户对象的主题集合。
[课程主题]

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 

[class级用户]

 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 

请帮帮我

Answer 1

由于您的sSubjects是一个Collection对象，因此您必须使用Set来为其分配一些内容。

此外，您不应该多次创build一个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