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