0

我想在我的 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
4

1 回答 1

1

我会用四个类来做到这一点：CCompany 和 CSale 以及两者的集合类。

C公司：

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

C公司：

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

销售：

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

销售：

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

于 2013-10-16T19:22:27.887 回答