VBA创建嵌套类

Question

我想在VBA中创建一个嵌套类。

到目前为止，我有成功创建如下：

OurCompany.Department.Employee("John") 

如何创建部门的几组这样我就可以seperately存储数据。 像这样

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和包装类可能被认为是无意义的，但考虑到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