我已經使用類模塊將近一年了，我現在才對它們感到滿意。現在我正在嘗試將工廠方法合并到作業簿表的資料提取中。我在此處、此處和此處找到了有關該主題的一些很棒的指南，但我不確定在哪里合并該類的集合。
到目前為止，我已經使用以下格式的自包含集合設定了我的類模塊：
類模塊 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
當我構建傳遞范圍/表、遍歷行并為每個屬性分配列值的函式時，此結構運行良好。地址幾乎總是不變的，只有值和記錄數會有所不同。
我剛剛開始為一個類構建一個介面，同時還試圖保留集合組件，但我在運行時出錯時遇到了困難......我可能會創建一個單獨的集合類，但我認為我的問題更多是關于范圍管理不當而不是封裝：
類模塊 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
介面模塊 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 指出我沒有說明我引入介面的意圖。
我的辦公室使用多個作業簿“模型”將定價資料編譯成單個輸出表，然后將其交付給下游客戶以匯入資料庫。
我的目標是使用這些不同的模型來標準化計算。次要目標是了解如何正確實作工廠方法。
Each model has one or more input tables, and each table contains a unique collection of 10-30 fields/columns. The output data calculations vary, along with the dependencies on various input fields. However, the output data is the same format all across the board and always contains the same dozen fields.
The example I've shown is intended to be a single interface ITestClass for writing data to the output table. The class that implements it CTestClass can be considered as just one of the several tables (within the several models) containing the input data. I plan on modeling more class objects, one for each input table.
uj5u.com熱心網友回復：
基于：
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
看起來您有興趣使您的類像集合一樣可迭代。我會向你指出這個問題。缺點是……很難。
關于錯誤：陳述句的結果Set oTest = CTestClass.Create是獲取了暴露單個方法的 FTestClass 介面：Public Function Create() As ITestClass。其中，提供了任何迭代上，并導致一個錯誤。
其他觀察：
在提供的代碼中，不需要宣告工廠介面。
（邊欄：介面類通常以字母“I”開頭。在這種情況下，更好的介面名稱FTestClass是“ITestClassFactory”）
由于 CTestClass 將其 VB_PredeclaredId 屬性設定為“True”，因此Public在其中宣告的任何方法（或欄位）都CTestClass被公開......并被視為其默認介面。 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依賴于 aListObject才能成為 a 的有效實體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
uj5u.com熱心網友回復：
我看到@BZgr 提供了一個解決方案，但由于我也寫了一個，我在下面提供了一個替代方案。
我認為 OP 代碼有幾個問題。
origclass 和 origclasses 的集合是混為一談的，它們應該是分開的。原始類 UDT 的糟糕命名并沒有使解決這個問題變得更容易。
不清楚什么需要成為工廠。我已將工廠方法放在 origclasses 類中，以便創建 origclass 的“不可變”集合。
目前尚不清楚 op 試圖通過引入介面來實作什么。通常，當許多不同的物件必須提供相同的方法集時，就會使用介面。在 VBA 中，介面宣告允許編譯器檢查聲稱實作介面的每個物件是否具有正確的方法和引數串列。（但我確實接受可能有一些特殊的 VBA 情況并非如此）
下面的代碼編譯并且沒有重要的 Rubberduck 檢查。但是，我不是 Excel VBA 的用戶，所以如果我的代碼在這方面出錯，我提前道歉。
一種。我們有一個單獨且非常簡單的 OrigClass
Option Explicit
Private Type Properties
Name As String
Cost As Long
End Type
Private p As Properties
Public Property Get Name() As String
Name = p.Name
End Property
Public Property Let Name(ByVal ipString As String)
p.Name = ipString
End Property
Public Property Get Cost() As Long
Cost = p.Cost
End Property
Public Property Let Cost(ByVal ipCost As Long)
p.Cost = ipCost
End Property
2 OrigClaases 類是 origclass 的集合
Option Explicit
'@PredeclaredId
'@Exposed
'Col position references for input table, only includes cols with relevant data
Private Enum icrColRef
icrName = 2
icrCost = 4
End Enum
Private Type State
'TestClass As Collection
Host As Collection
ExternalData As Excel.Worksheet
TableName As String
End Type
Private s As State
Public Function Deb(ByVal ipWorksheet As Excel.Worksheet, ByVal ipTableName As String) As OrigClasses
With New OrigClasses
Set Deb = .ReadyToUseInstance(ipWorksheet, ipTableName)
End With
End Function
Friend Function ReadyToUseInstance(ByVal ipWorksheet As Excel.Worksheet, ByVal ipTableName As String) As OrigClasses
Set s.Host = New Collection
Set s.ExternalData = ipWorksheet
s.TableName = ipTableName
PopulateHost
Set ReadyToUseInstance = Me
End Function
' The fact that you are using the collection Key suggests
' you might be better of using a scripting.dictioanry
' Also given that you populate host doirectly from the worksheet
' this add method may now be redundant.
Public Sub Add(ByVal ipItem As OrigClass)
s.Host.Add _
Item:=ipItem, _
Key:=ipItem.Name
End Sub
Public Sub Extract()
' Extract is restricted to re extracting data
' should the worksheet have been changed.
' If you need to work on a new sheet then
' create a new OrigClasses object
Set s.Host = New Collection
PopulateHost
End Sub
Private Sub PopulateHost()
Dim tblInputs As ListObject
Set tblInputs = s.ExternalData.ListObjects(s.TableName)
Dim myRow As Long
For myRow = 1 To tblInputs.DataBodyRange.Rows.Count
Dim myItem As OrigClass
Set myItem = New OrigClass
With myItem
.Name = tblInputs.DataBodyRange(myRow, icrName).Value
.Cost = tblInputs.DataBodyRange(myRow, icrCost).Value
End With
s.Host.Add myItem, myItem.Name
Next
End Sub
Public Function Item(ByVal ipIndex As Variant) As OrigClass
Set Item = s.Host.Item(ipIndex)
End Function
Public Function Count() As Long
Count = s.Host.Count
End Function
Public Function Name(ByVal ipIndex As Long) As String
Name = s.Host.Item(ipIndex).Name
End Function
Public Function Cost(ByVal ipIndex As Long) As Long
Cost = s.Host.Item(ipIndex).Cost
End Function
Public Function SheetName() As String
SheetName = s.ExternalData.Name
End Function
Public Function TableName() As String
TableName = s.TableName
End Function
'@Enumerator
Public Function NewEnum() As IUnknown
Set NewEnum = s.Host.[_NewEnum]
End Function
C。測驗代碼
Option Explicit
Const WS_NAME As String = "Sheet1"
Const NR_TBL As String = "Table1"
Sub TestFactory()
Dim oTest As OrigClasses
'@Ignore UnassignedVariableUsage
Set oTest = OrigClasses.Deb(ThisWorkbook.Worksheets(WS_NAME), NR_TBL)
Dim myOrigClass As Variant
For Each myOrigClass In oTest
Debug.Print
Debug.Print myOrigClass.Name
Debug.Print myOrigClass.Cost
Next
End Sub
For the factory method, following feeback from Rubberduck, I now use the method name 'Deb' which is short for Debut (or Debutante) meaning something that is presented which is ready to be used. Which of course leads to why I use the method name 'readytoUseInstance'.
I Use UDT of Properties and State (with variables p and s) to separate extenal properties from internal state.
Within methods I prefix variables with the prefix 'my'.
For method parameters i use the prefixed ip, op and iop for input only, output only, and imput that is mutated and output.
A side benefit of these prefixes p,s,my,ip,op,iop is that they also remove some the majority of the issues encountered when trying to name variables/parameters.
轉載請註明出處，本文鏈接：https://www.uj5u.com/houduan/338855.html
標籤：excel vba collections interface factory
上一篇：如何復制列標題為“測驗”的列
下一篇：大一C語言學習筆記（6）---自省篇--流程控制；break，continue，return間的異同；陣列應用到回圈陳述句中需要注意的問題；++i 和 i++的異同等。