excel - 如何将 Excel VBA 类集合合并到接口(interface)/工厂方法中？

Question

我已经使用类模块快一年了，现在我对它们感到很舒服。现在我正在尝试将工厂方法合并到从工作簿表中提取数据中。我在 here 主题上找到了一些很棒的指南, here , 和 here ，但我不确定在哪里合并该类的集合。
到目前为止，我已经使用这种格式的自包含集合设置了我的类模块:
类(class)模块 OrigClass

Option Explicit

'Col position references for input table, only includes cols with relevant data
Private Enum icrColRef
    icrName = 2
    icrCost = 4
End Enum

'UDT mirrors class properties
Private Type TTestClass
    Name                                As String
    Cost                                As Long
End Type

Const WS_NAME                           As String = "Sheet1"
Const NR_TBL                            As String = "Table1"

Private msTestClass                     As Collection
Private TestClass                       As TTestClass


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

Public Sub Add(Item As OrigClass)
    msTestClass.Add _
        Item:=Item, _
        Key:=Item.Name
End Sub

Public Function Extract() As OrigClass
    Dim tblInputs                       As ListObject
    Dim i                               As Integer
    Dim Item                            As OrigClass

    Set tblInputs = ThisWorkbook.Worksheets(WS_NAME).ListObjects(NR_TBL)

    For i = 1 To tblInputs.DataBodyRange.Rows.Count
        Set Item = New OrigClass
        
        With Item
            .Name = tblInputs.DataBodyRange(i, icrName).Value
            .Cost = tblInputs.DataBodyRange(i, icrCost).Value
        End With

        msTestClass.Add Item
    Next i
End Function

Public Function Item(i As Variant) As OrigClass
    Set Item = msTestClass.Item(i)
End Function

Public Function Count() As Integer
    Count = msTestClass.Count
End Function


Friend Property Let Name(Val As String)
    TestClass.Name = Val
End Property

Public Property Get Name() As String
    Name = TestClass.Name
End Property

Friend Property Let Cost(Val As Long)
    TestClass.Cost = Val
End Property

Public Property Get Cost() As Long
    Cost = TestClass.Cost
End Property

当我构建传递范围/表、遍历行并为每个属性分配列值的函数时，这种结构效果很好。地址几乎总是不变的，只有值和记录数会发生变化。
我刚开始为一个类构建一个接口(interface)，同时还试图保留集合组件，但我遇到了运行时错误......我可能会 create a separate collection class ，但我认为我的问题更多是关于范围管理不善而不是封装:
类(class)模块 CTestClass

Option Explicit

'Col position references for input table, only includes cols with relevant data
Private Enum icrColRef
    icrName = 2
    icrCost = 4
End Enum

''UDT mirrors class properties
Private Type TTestClass
    Name                                As String
    Cost                                As Long
End Type

Const WS_NAME                           As String = "Sheet1"
Const NR_TBL                            As String = "Table1"

Private msTestClass                     As Collection
Private TestClass                       As TTestClass

Implements ITestClass
Implements FTestClass


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

Public Sub Add(Item As CTestClass)
    msTestClass.Add _
        Item:=Item, _
        Key:=Item.Name
End Sub

Public Function Create() As ITestClass
    With New CTestClass
        .Extract
' 2) now in Locals window, Me.msTestClass is <No Variables>
        Set Create = .Self
' 4) Me.msTestClass is again <No Variables>, and
'       Create (as Type ITextClass) is Nothing
'       Create (as Type ITextClass/ITextClass) lists property values as
'           <Object doesn't support this property or method>, aka runtime error 438
    End With
End Function

Private Function FTestClass_Create() As ITestClass
    Set FTestClass_Create = Create
End Function

Public Function Extract() As ITestClass
    Dim tblInputs                       As ListObject
    Dim i                               As Integer
    Dim Item                            As CTestClass

    Set tblInputs = ThisWorkbook.Worksheets(WS_NAME).ListObjects(NR_TBL)

    For i = 1 To tblInputs.DataBodyRange.Rows.Count
        Set Item = New CTestClass
        
        With Item
            .Name = tblInputs.DataBodyRange(i, icrName).Value
            .Cost = tblInputs.DataBodyRange(i, icrCost).Value
        End With

        msTestClass.Add Item
    Next i
' 1) in Locals window, Me.msTestClass is populated with all table records
End Function

Public Function ITestClass_Item(i As Variant) As ITestClass
    Set ITestClass_Item = msTestClass.Item(i)
End Function

Public Function ITestClass_Count() As Integer
    ITestClass_Count = msTestClass.Count
End Function


Friend Property Let Name(Val As String)
    TestClass.Name = Val
End Property

Public Property Get Name() As String
    Name = TestClass.Name
End Property

Friend Property Let Cost(Val As Long)
    TestClass.Cost = Val
End Property

Public Property Get Cost() As Long
    Cost = TestClass.Cost
End Property


Public Property Get Self() As ITestClass
    Set Self = Me
' 3) Me.msTestClass is again populated with all table records (scope shift?), but
'       Self is set to Nothing
End Property

Private Property Get ITestClass_Name() As String
    ITestClass_Name = Name
End Property

Private Property Get ITestClass_Cost() As Long
    ITestClass_Cost = Cost
End Property

接口(interface)模块 ITestClass

'Attribute VB_PredeclaredId = False     <-- revised in text editor
Option Explicit


Public Function Item(i As Variant) As ITestClass
End Function

Public Function Count() As Integer
End Function


Public Property Get Name() As String
End Property

Public Property Get Cost() As Long
End Property

工厂模块 FTestClass

'Attribute VB_PredeclaredId = False     <-- revised in text editor
Option Explicit


Public Function Create() As ITestClass
End Function

标准模块

Sub TestFactory()
    Dim i                               As ITestClass
    Dim oTest                           As FTestClass
    
    Set oTest = CTestClass.Create
' 5) oTest is <No Variables>, no properties are present
'       as if the variable was never set
    
    For Each i In oTest     ' <-- Runtime error 438, Object doesn't support this property or method
        Debug.Print
        Debug.Print i.Name
        Debug.Print i.Cost
    Next i
End Sub

我在这里做错了什么？
编辑:
@freeflow 指出我没有说明引入界面的意图。
我的办公室使用多个工作簿“模型”将定价数据编译为单个输出表，然后将其交付给下游客户以导入数据库。
我的目标是使用这些不同的模型标准化计算。附带目标是了解如何正确实现工厂方法。
每个模型都有一个或多个输入表，每个表包含 10-30 个字段/列的唯一集合。输出数据计算不同，以及对各种输入字段的依赖关系。但是，输出数据的格式全部相同，并且始终包含相同的十几个字段。
我展示的示例旨在成为单个接口(interface) ITestClass用于将数据写入输出表。实现它的类 CTestClass可以被认为只是包含输入数据的几个表(在几个模型中)之一。我计划对更多类对象建模，每个输入表一个。

Answer 1

基于:

Sub TestFactory()
    Dim i                               As ITestClass
    Dim oTest                           As FTestClass
    
    Set oTest = CTestClass.Create
' 5) oTest is <No Variables>, no properties are present
'       as if the variable was never set
    
    For Each i In oTest     ' <-- Runtime error 438, Object doesn't support this property or method
        Debug.Print
        Debug.Print i.Name
        Debug.Print i.Cost
    Next i
End Sub

您似乎有兴趣使您的类像集合一样可迭代。我会把你指向 this SO question .缺点是……很难。
关于错误:语句的结果 Set oTest = CTestClass.Create是获取一个暴露单个方法的 FTestClass 接口(interface): Public Function Create() As ITestClass .其中，没有提供任何迭代并导致错误。
其他观察:
在提供的代码中，不需要声明工厂接口(interface)。
(边栏:接口(interface)类通常以字母“I”开头。在这种情况下， FTestClass 的更好接口(interface)名称是“ITestClassFactory”)
由于 CTestClass 的 VB_PredeclaredId 属性设置为“True”，因此任何 Public CTestClass 中声明的方法(或字段)被暴露...并被认为是其默认接口(interface)。 CTestClass.Create()是您感兴趣的工厂方法。
创建工厂方法(在 VBA 中)的一个目的是支持类实例的参数化创建。由于 Create函数目前没有参数，不清楚创建过程中除了 Set tClass = new CTestClass 之外还能发生什么.但是，有一些参数可以指示 Create 期间发生的情况。 .

Public Function Create(ByVal tblInputs As ListObject, OPtional ByVal nameColumn As Long = 2, Optional ByVal costColumn As Long = 4) As ITestClass

换句话说， CTestClass依赖于 ListObject为了成为 CTestClass 的有效实例.工厂方法的签名通常包含类的依赖项。使用上述工厂方法，不再需要 Extract功能 - Public或其他。还要注意(在下面的代码中) ThisWorkbook引用不再是对象的一部分。现在， tblInputs ListObject可以来自任何地方。并且可以轻松修改重要的列号。此参数列表允许您使用带有假数据的工作表来测试此类。
重组: CTestClass包含 Collection的 CTestClass实例。声明 TestClassContainer 似乎更清楚。暴露 Create 的类上面的功能。然后容器类可以公开一个 NameCostPairs简单地暴露 msTestClass 的属性 Collection .创建容器类将 TestClass 本质上简化为一个数据对象(所有属性，无方法)，从而实现有用的关注点分离。让调用对象处理集合的迭代。
测试类容器

Option Explicit

Private Type TTestClassContainer
    msTestClass As Collection
End Type

Private this                       As TTestClassContainer

'TestContainer Factory method
Public Function Create(ByVal tblInputs As ListObject, Optional ByVal nameCol As Long = 2, Optional ByVal costCol As Long = 4) As TestClassContainer
    Dim i As Integer
    Dim nameCostPair As CTestClass
    
    Dim newInstance As TestClassContainer

    With New TestClassContainer
        Set newInstance = .Self
        For i = 1 To tblInputs.DataBodyRange.Rows.Count
            Set nameCostPair = New CTestClass
            nameCostPair.Name = tblInputs.DataBodyRange(i, nameCol).Value
            nameCostPair.Cost = tblInputs.DataBodyRange(i, costCol).Value
            
            newInstance.AddTestClass nameCostPair
        Next i
    End With
    
    Set Create = newInstance
    
End Function

Public Sub AddTestClass(ByVal tstClass As CTestClass)
    this.msTestClass.Add tstClass
End Sub

Public Property Get Self() As CTestClass
    Set Self = Me
End Property

Public Property Get NameCostPairs() As Collection
    Set NameCostPairs = this.msTestClass
End Property

CTestClass(不再需要 VB_PredeclaredId 设置为 'True')

Option Explicit

Implements ITestClass

''UDT mirrors class properties
Private Type TTestClass
    Name As String
    Cost As Long
End Type

Private this As TTestClass

Public Property Let Name(Val As String)
    this.Name = Val
End Property

Public Property Get Name() As String
    Name = this.Name
End Property

Public Property Let Cost(Val As Long)
    this.Cost = Val
End Property

Public Property Get Cost() As Long
    Cost = this.Cost
End Property

Private Property Get ITestClass_Name() As String
    ITestClass_Name = Name
End Property

Private Property Get ITestClass_Cost() As Long
    ITestClass_Cost = Cost
End Property

最后:

Option Explicit

Sub TestFactory()
    Const WS_NAME As String = "Sheet1"
    Const NR_TBL As String = "Table1"
    
    Dim tblInputs As ListObject

    Set tblInputs = ThisWorkbook.Worksheets(WS_NAME).ListObjects(NR_TBL)

    Dim container As TestClassContainer
    Set container = TestClassContainer.Create(tblInputs)
    
    Dim nameCostPair As ITestClass
    Dim containerItem As Variant
    For Each containerItem In container.NameCostPairs
        Set nameCostPair = containerItem
        Debug.Print
        Debug.Print nameCostPair.Name
        Debug.Print nameCostPair.Cost
    Next
End Sub