创建具有子级别的类属性

我一直在读这个topic https://excelmacromastery.com/vba-class-modules/#A_Quick_Guide_to_the_VBA_Class_Module关于如何使用类模块。

我的目标是提高代码性能和可读性，所以我认为我走在正确的道路上。

但我对这些限制有一些疑问。

在我的脑海里，我想这样做：

这样的结构可以实现吗？

我读过的主题的例子很少，并且没有处理这个问题。我假设这对于集合的集合是可能的，但我不知道如何寻找它。

我的数据来自 2 个表，一个表包含除部门之外的所有项目，另一个表包含部门旁边的 ID。两个表都将当前月份的日期作为标题，并根据表的不同安排/部门。

我一天知道如何实现这一目标，但一整月都不知道。

这就是我为班级编写基础知识的方式：

Option Explicit
Private DirNeg As String
Private Agrup As String
Private DNI As String
Private Centro As String
Private Servicio As String
Private Nombre As String
Property Get Business() As String
    Business = DirNeg
End Property
Property Let Business(ByVal sBusiness As String)
    DirNeg = sBusiness
End Property
Property Get Group() As String
    Group = Agrup
End Property
Property Let Group(ByVal sGroup As String)
    Agrup = sGroup
End Property
Property Get ID() As String
    ID = DNI
End Property
Property Let ID(ByVal sID As String)
    DNI = sID
End Property
Property Get Location() As String
    Location = Centro
End Property
Property Let Location(ByVal sLocation As String)
    Centro = sLocation
End Property
Property Get Service() As String
    Service = Servicio
End Property
Property Let Service(ByVal sService As String)
    Servicio = sService
End Property
Property Get Name() As String
    Name = Nombre
End Property
Property Let Name(ByVal sName As String)
    Nombre = sName
End Property

另一方面，将整个班级填满是否正确？Class_Initialize事件？我的数据将始终相同，因此我不需要在普通模块中循环来填充类，每次创建类时都可以完成此操作。

编辑/更新：

这是我的数据的样子：

时间表以及代理信息

代理 ID 旁边的部门

clAgent 类模块：

Option Explicit
Private DirNeg As String
Private Agrup As String
Private DNI As String
Private Centro As String
Private Servicio As String
Private Nombre As String
Private Fechas As Object
Property Get Business() As String
    Business = DirNeg
End Property
Property Let Business(ByVal sBusiness As String)
    DirNeg = sBusiness
End Property
Property Get Group() As String
    Group = Agrup
End Property
Property Let Group(ByVal sGroup As String)
    Agrup = sGroup
End Property
Property Get ID() As String
    ID = DNI
End Property
Property Let ID(ByVal sID As String)
    DNI = sID
End Property
Property Get Location() As String
    Location = Centro
End Property
Property Let Location(ByVal sLocation As String)
    Centro = sLocation
End Property
Property Get Service() As String
    Service = Servicio
End Property
Property Let Service(ByVal sService As String)
    Servicio = sService
End Property
Property Get Name() As String
    Name = Nombre
End Property
Property Let Name(ByVal sName As String)
    Nombre = sName
End Property
Property Get clFechas(ByVal StringKey As String) As clFechas
    With Fechas
        If Not .Exists(StringKey) Then
            Dim objFechas As New clFechas
            .Add StringKey, objFechas
        End If
    End With

End Property
Private Sub Class_Initialize()

    Set Fechas = CreateObject("Scripting.Dictionary")

End Sub

clFechas 类模块：

Option Explicit
Private Modos As Object
Private Horarios As Object
'Aqiço creamos la propiedad Modo para la clase Fecha
Public Property Get Modo(ByVal StringKey As String) As String
    Modo = Modos(StringKey)
End Property
Public Property Let Modo(ByVal StringKey As String, ByVal StringValue As String)
    Modos(StringKey) = StringValue
End Property
Public Property Get Keys() As Variant
    Keys = Modos.Keys
End Property
'Aquí creamos la propiedad Horario para la clase Fecha
Public Property Get Horario(ByVal StringKey As String) As String
    Modo = Horarios(StringKey)
End Property
Public Property Let Horario(ByVal StringKey As String, ByVal StringValue As String)
    Horarios(StringKey) = StringValue
End Property
Public Property Get Keys() As Variant
    Keys = Horarios.Keys
End Property
'Iniciamos la clase
Private Sub Class_Initialize()
    Set Modos = CreateObject("Scripting.Dictionary")
    Set Horarios = CreateObject("Scripting.Dictionary")
End Sub
Private Sub Class_Terminate()
    Set Modos = Nothing
    Set Horarios = Nothing
End Sub

您似乎对常规属性没有任何问题，所以让我们关注复杂的属性；时间表和部门。两者是相同的，因此相同的规则适用于两者。

属性基本上是列表，日期是索引，项目是对象。我个人更喜欢使用字典，因为我可以查看密钥是否存在等。

因此，您的 Agent 类可能如下所示：

Option Explicit
Private m_schedules As Object

Public Property Get Schedule(ByVal Key As Date) As Schedules
    With m_schedules
        If Not .Exists(Key) Then .Add Key, New Schedules
    End With
    Set Schedule = m_schedules(Key)
End Property

'For testing purposes - can be ommited.
Public Property Get Keys() As Variant
    Keys = m_schedules.Keys
End Property

'For testing purposes - can be ommited.
Public Property Get Count() As Long
    Count = m_schedules.Count
End Property

Private Sub Class_Initialize()
    Set m_schedules = CreateObject("Scripting.Dictionary")
End Sub

Private Sub Class_Terminate()
    Set m_schedules = Nothing
End Sub

时间表类：

Option Explicit
Private m_schedule As String

Public Property Get Schedule() As String
    Schedule = m_schedule
End Property
Public Property Let Schedule(ByVal param As String)
    m_schedule = param
End Property

现在，我们来测试一下：

Sub Test()

    Dim obj As Agent
    Set obj = New Agent

    obj.Schedule(#1/9/2019#).Schedule = "Schedule 1"
    obj.Schedule(#2/9/2019#).Schedule = "Schedule 2"
    obj.Schedule(#3/9/2019#).Schedule = "Schedule 3"

    PrintToDebug obj

    'Lets make a change
    obj.Schedule(#2/9/2019#).Schedule = "Schedule 2222"

    PrintToDebug obj

End Sub


Private Sub PrintToDebug(ByVal obj As Agent)

    Debug.Print ""

    Dim m As Variant
    With obj
        For Each m In .Keys
            Debug.Print "Key: " & m & String(3, " ") & "Value: " & .Schedule(m).Schedule
        Next m
    End With

    Debug.Print "Total Items: " & obj.Count
End Sub

Output:

'Key: 09/01/2019   Value: Schedule 1
'Key: 09/02/2019   Value: Schedule 2
'Key: 09/03/2019   Value: Schedule 3
'Total Items: 3

'Key: 09/01/2019   Value: Schedule 1
'Key: 09/02/2019   Value: Schedule 2222
'Key: 09/03/2019   Value: Schedule 3
'Total Items: 3

有关的附加信息Dictionary对象可以在这里找到：字典对象 https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/dictionary-object

也要记住这一点。这非常重要：

如果在更改项目时未找到密钥，则会创建一个新密钥 指定的新项目。如果尝试返回时未找到密钥 一个现有的项目，一个新的键被创建，它对应的项目是 留空。

如果字典项不是简单的字符串，请告诉我更新答案。抱歉，我无法读取屏幕截图中的数据。 :)