VBA创建嵌套类

Question

我试图在VBA中创建一个嵌套类.

到目前为止,我已成功创建以下内容:

OurCompany.Department.Employee("John")

如何创建一些部门组,以便我可以单独存储数据.像这样的东西

OurCompany.Department("Finance").Employee("John") = "Employee Number 100"
OurCompany.Department("Finance").Employee("Kim") = "Employee Number 101"
OurCompany.Department("Engineering").Employee("Sam") = "Employee Number 124"

cDeparment类

Private pDepartmentEmployee As Collection
Public Property Get Department(RefString As String) As cEmployee

    Set Department = pDepartment.Item(RefString)

End Property

Public Property Set Department(RefString As String, ByVal objDepartEmployee As cEmployee)

    pDepartmentEmployee.Add objDepartEmployee, RefString

End Property

cEmployee Class

Private pEmployee As Collection
Public Property Get Employee(RefKey As String) As String

    Employee = pEmployee.Item(RefKey)

End Property

Public Property Let Employee(RefKey As String, RefItem As String)

    pEmployee.Add Item:=RefItem, Key:=RefKey

End Property

Answer 1

我强烈建议阅读在回答这个职位包括连接的任何引用.

然而,一个简单的实现可以如下.

公司类:

Option Explicit
Private mDepartmentsList As Object

Public Property Get Department(ByVal StringKey As String) As Department
    With mDepartmentsList
        If Not .Exists(StringKey) Then
            Dim objDepartment As New Department
            .Add StringKey, objDepartment
        End If
    End With

    Set Department = mDepartmentsList(StringKey)
End Property

Public Property Get Keys() As Variant
    Keys = mDepartmentsList.Keys
End Property

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

Private Sub Class_Terminate()
    Set mDepartmentsList = Nothing
End Sub

部门类:

Option Explicit
Private mEmployeesList As Object

Public Property Get Employee(ByVal StringKey As String) As String
    Employee = mEmployeesList(StringKey)
End Property

Public Property Let Employee(ByVal StringKey As String, ByVal StringValue As String)
    mEmployeesList(StringKey) = StringValue
End Property

Public Property Get Keys() As Variant
    Keys = mEmployeesList.Keys
End Property

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

Private Sub Class_Terminate()
    Set mEmployeesList = Nothing
End Sub

执行:

Option Explicit

Sub TestCompanyClass()

    Dim OurCompany As Company
    Set OurCompany = New Company

    With OurCompany
        .Department("Finance").Employee("John") = "Employee Number 100"
        .Department("Finance").Employee("Kim") = "Employee Number 101"
        .Department("Engineering").Employee("Sam") = "Employee Number 124"
    End With

    Dim d As Variant, e As Variant
    With OurCompany
        For Each d In .Keys
            Debug.Print "Department: " & d
            For Each e In .Department(d).Keys
                Debug.Print vbTab & "Employee: " & e & " - " & .Department(d).Employee(e)
            Next e
        Next d
    End With

    Set OurCompany = Nothing
End Sub

输出:

Department: Finance
    Employee: John - Employee Number 100
    Employee: Kim - Employee Number 101
Department: Engineering
    Employee: Sam - Employee Number 124