创建嵌套类

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类

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

我强烈建议阅读this 帖子中的答案，包括任何附加的参考资料。

不过，一个简单的实现可能如下。

公司类别：

---

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

Answer 2

在这里你可以用这样的类创建对象模型：

Company -> has Departments -> Department -> has Employees -> Employee

创建像Departments 和Employees 这样的包装类可能看起来没有目的，但考虑到VBA.Collection 可以容纳任何东西，而不仅仅是Department 或Employee 的实例，所以这样的集合包装确保集合仅包含特定类型的对象。

Dim col As VBA.Collection
Set col = New VBA.Collection

col.Add 123, CStr(123)
col.Add Range("A1:C3"), "Range(""A1:C3"")"
col.Add "banana", "banana"

Dim wing As Employee
Set wing = New Employee
wing.Id = 200
wing.Name = "Wing"

col.Add wing, CStr(wing.Id)

Debug.Print col.Count ' Prints 4

简单的例子，HTH。

公司

Private m_departmets As Departmets

Public Property Get Departmets() As Departmets
    Set Departmets = m_departmets
End Property

Private Sub Class_Initialize()
    Set m_departmets = New Departmets
End Sub

部门

Private m_items As VBA.Collection

Private Sub Class_Initialize()
    Set m_items = New VBA.Collection
End Sub

Public Sub AddItem(newItem As Department)
    m_items.Add newItem, newItem.Name
End Sub

Public Function GetItem(Name As String) As Department
    Set GetItem = m_items(Name)
End Function

部门

Private m_name As String
Private m_employees As Employees

Public Property Get Name() As String
    Name = m_name
End Property

Public Property Let Name(ByVal vNewValue As String)
    m_name = vNewValue
End Property

Public Property Get Employees() As Employees
    Set Employees = m_employees
End Property

Private Sub Class_Initialize()
    Set m_employees = New Employees
End Sub

员工

Private m_items As VBA.Collection

Private Sub Class_Initialize()
    Set m_items = New VBA.Collection
End Sub

Public Sub AddItem(newItem As Employee)
    m_items.Add newItem, VBA.CStr(newItem.Id)
End Sub

Public Function GetItem(Id As Long) As Employee
    Set GetItem = m_items(VBA.CStr(Id))
End Function

员工

Private m_name As String
Private m_id As Long

Public Property Get Name() As String
    Name = m_name
End Property

Public Property Let Name(ByVal vNewValue As String)
    m_name = vNewValue
End Property

Public Property Get Id() As Long
    Id = m_id
End Property

Public Property Let Id(ByVal vNewValue As Long)
    m_id = vNewValue
End Property

测试

Sub Test()
    Dim john As Employee
    Dim kim As Employee
    Dim sam As Employee
    Dim financeDepartment As Department
    Dim engineeringDepartment As Department
    Dim ourCompany As Company

    Set john = New Employee
    Set kim = New Employee
    Set sam = New Employee

    john.Name = "John"
    john.Id = 100
    kim.Name = "Kim"
    kim.Id = 101
    sam.Name = "Sam"
    sam.Id = 124

    Set financeDepartment = New Department
    Set engineeringDepartment = New Department

    financeDepartment.Name = "Finance"
    engineeringDepartment.Name = "Engineering"

    financeDepartment.Employees.AddItem john
    financeDepartment.Employees.AddItem kim
    engineeringDepartment.Employees.AddItem sam

    Set ourCompany = New Company
    ourCompany.Departmets.AddItem financeDepartment
    ourCompany.Departmets.AddItem engineeringDepartment

    Debug.Print ourCompany.Departmets.GetItem("Finance").Employees.GetItem(100).Name
    Debug.Print ourCompany.Departmets.GetItem("Finance").Employees.GetItem(101).Name
    Debug.Print ourCompany.Departmets.GetItem("Engineering").Employees.GetItem(124).Name

    ' Change name of Sam to Samuel
    ourCompany.Departmets.GetItem("Engineering").Employees.GetItem(124).Name = "Samuel"
    Debug.Print ourCompany.Departmets.GetItem("Engineering").Employees.GetItem(124).Name
End Sub

输出

John
Kim
Sam
Samuel