使用嵌套數組的類

Question

我想在我的VBA程序中使用類而不是結構，但無法弄清楚。以下是我正在做的事情的一個例子，並會對任何建議表示感謝。也許班對這種類型的事情不好，因爲它對我來說似乎不是很直觀，我不知道。

Option Explicit 
Public Type xYear 
    month(1 To 12) As Double ' Index is the month 
End Type 
Public Type Company 
    Name As String 
    City As String 
    Sales(2010 To 2020) As xYear ' Index is the year 
End Type 
Public SuperData(1 To 50) As Company ' An array of companies with monthly sales 
Sub Test_Table() 
    Dim Company1_Name As String 
    Dim Company1_City As String 
    Dim Company1_2011_Sales(1 To 12) As Double 
    Dim Company1_2012_Sales(1 To 12) As Double 
    Dim Toledo_Sales_Jul_2012 As Double 
    ' Test Data 
    Company1_Name = "ABC" 
    Company1_City = "Toledo" 
    Company1_2011_Sales(7) = 1000 
    Company1_2012_Sales(7) = 2000 
    ' Copy test data into Structure 
    SuperData(1).Name = Company1_Name 
    SuperData(1).City = Company1_City 
    SuperData(1).Sales(2011).month(7) = Company1_2011_Sales(1) ' Jul 2011 sales 
    SuperData(1).Sales(2012).month(7) = Company1_2012_Sales(7) ' Jul 2012 sales 
    ' Query the structure 
    Toledo_Sales_Jul_2012 = City_Sales("Toledo", 7, 2012) 
End Sub 
Public Function City_Sales(ByRef City As String, ByRef m As Double, ByRef y As Double) As Double 
     Dim c As Double 
     For c = LBound(SuperData) To UBound(SuperData) 
     If City = SuperData(c).City Then 
      City_Sales = City_Sales + SuperData(c).Sales(y).month(m) 
     End If 
    Next 
End Function 

Answer 1

我會用四個類來做到這一點：CCompany和CSale以及兩者的集合類。

CCompany：

Private mlCompanyID As Long 
Private msCompanyName As String 
Private msCity As String 
Private mclsSales As CSales 
Private mlParentPtr As Long 
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _ 
    (dest As Any, Source As Any, ByVal bytes As Long) 


Public Property Set Sales(ByVal clsSales As CSales): Set mclsSales = clsSales: End Property 
Public Property Get Sales() As CSales: Set Sales = mclsSales: End Property 
Public Property Let CompanyID(ByVal lCompanyID As Long): mlCompanyID = lCompanyID: End Property 
Public Property Get CompanyID() As Long: CompanyID = mlCompanyID: End Property 
Public Property Let CompanyName(ByVal sCompanyName As String): msCompanyName = sCompanyName: End Property 
Public Property Get CompanyName() As String: CompanyName = msCompanyName: End Property 
Public Property Let City(ByVal sCity As String): msCity = sCity: End Property 
Public Property Get City() As String: City = msCity: End Property 
Public Property Get Parent() As CCompanies: Set Parent = ObjFromPtr(mlParentPtr): End Property 
Public Property Set Parent(obj As CCompanies): mlParentPtr = ObjPtr(obj): End Property 

Private Function ObjFromPtr(ByVal pObj As Long) As Object 
    Dim obj As Object 
    CopyMemory obj, pObj, 4 
    Set ObjFromPtr = obj 
    ' manually destroy the temporary object variable 
    ' (if you omit this step you'll get a GPF!) 
    CopyMemory obj, 0&, 4 
End Function 

Private Sub Class_Initialize() 
    Set mclsSales = New CSales 
End Sub 

Private Sub Class_Terminate() 
    Set mclsSales = Nothing 
End Sub 

CCompanies：

Private mcolCompanies As Collection 

Private Sub Class_Initialize() 
    Set mcolCompanies = New Collection 
End Sub 

Private Sub Class_Terminate() 
    Set mcolCompanies = Nothing 
End Sub 

Public Property Get NewEnum() As IUnknown 
    Set NewEnum = mcolCompanies.[_NewEnum] 
End Property 

Public Sub Add(clsCompany As CCompany) 
    If clsCompany.CompanyID = 0 Then 
     clsCompany.CompanyID = Me.Count + 1 
    End If 

    Set clsCompany.Parent = Me 
    mcolCompanies.Add clsCompany, CStr(clsCompany.CompanyID) 
End Sub 

Public Property Get Company(vItem As Variant) As CCompany 
    Set Company = mcolCompanies.Item(vItem) 
End Property 

Public Property Get Count() As Long 
    Count = mcolCompanies.Count 
End Property 

CSale：

Private mlSaleID As Long 
Private mdAmount As Double 
Private mlYear As Long 
Private mlMonth As Long 
Private mlParentPtr As Long 
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _ 
    (dest As Any, Source As Any, ByVal bytes As Long) 


Public Property Let SaleID(ByVal lSaleID As Long): mlSaleID = lSaleID: End Property 
Public Property Get SaleID() As Long: SaleID = mlSaleID: End Property 
Public Property Let Amount(ByVal dAmount As Double): mdAmount = dAmount: End Property 
Public Property Get Amount() As Double: Amount = mdAmount: End Property 
Public Property Let Year(ByVal lYear As Long): mlYear = lYear: End Property 
Public Property Get Year() As Long: Year = mlYear: End Property 
Public Property Let Month(ByVal lMonth As Long): mlMonth = lMonth: End Property 
Public Property Get Month() As Long: Month = mlMonth: End Property 
Public Property Get Parent() As CSales: Set Parent = ObjFromPtr(mlParentPtr): End Property 
Public Property Set Parent(obj As CSales): mlParentPtr = ObjPtr(obj): End Property 

Private Function ObjFromPtr(ByVal pObj As Long) As Object 
    Dim obj As Object 
    CopyMemory obj, pObj, 4 
    Set ObjFromPtr = obj 
    ' manually destroy the temporary object variable 
    ' (if you omit this step you'll get a GPF!) 
    CopyMemory obj, 0&, 4 
End Function 

CSales：

Private mcolSales As Collection 

Private Sub Class_Initialize() 
    Set mcolSales = New Collection 
End Sub 

Private Sub Class_Terminate() 
    Set mcolSales = Nothing 
End Sub 

Public Property Get NewEnum() As IUnknown 
    Set NewEnum = mcolSales.[_NewEnum] 
End Property 

Public Sub Add(clsSale As CSale) 
    If clsSale.SaleID = 0 Then 
     clsSale.SaleID = Me.Count + 1 
    End If 

    Set clsSale.Parent = Me 
    mcolSales.Add clsSale, CStr(clsSale.SaleID) 
End Sub 

Public Property Get Sale(vItem As Variant) As CSale 
    Set Sale = mcolSales.Item(vItem) 
End Property 

Public Property Get Count() As Long 
    Count = mcolSales.Count 
End Property 


Public Sub AddSale(ByVal dAmount As Double, ByVal lYear As Long, ByVal lMonth As Long) 

    Dim clsSale As CSale 

    Set clsSale = New CSale 
    With clsSale 
     .Amount = dAmount 
     .Year = lYear 
     .Month = lMonth 
    End With 

    Me.Add clsSale 

End Sub 

然後在標準模塊中。

Sub Test_Class() 

    Dim clsCompanies As CCompanies 
    Dim clsCompany As CCompany 
    Dim clsSale As CSale 

    Set clsCompanies = New CCompanies 

    Set clsCompany = New CCompany 
    clsCompany.CompanyName = "ABC" 
    clsCompany.City = "Toledo" 

    'Verbose way to add a sale 
    Set clsSale = New CSale 
    clsSale.Amount = 1000 
    clsSale.Year = 2011 
    clsSale.Month = 7 
    clsCompany.Sales.Add clsSale 

    'Quickway to add a sale 
    clsCompany.Sales.AddSale 2000, 2012, 7 

    clsCompanies.Add clsCompany 

    For Each clsCompany In clsCompanies 
     For Each clsSale In clsCompany.Sales 
      Debug.Print clsCompany.CompanyName, clsCompany.City, clsSale.Amount, clsSale.Year, clsSale.Month 
     Next clsSale 
    Next clsCompany 

End Sub 

這使用了一些未記錄的功能，例如能夠在自定義類中使用For Each。這裏有幾個參考資料給你。

http://dailydoseofexcel.com/archives/2010/07/09/creating-a-parent-class/

http://www.cpearson.com/excel/classes.aspx