类对象VBA中的单个属性的多个实例

假设我创build了一个名为Farm的类。 它有3个属性：

• FarmName as String
• NumberOfStables as Long
• HasHorse as Boolean

我开始上课

 Dim SmithFarm as Farm Set SmithFarm = New Farm SmithFarm.FarmName = "Smith Farm" SmithFarm.NumberOfStables = 3 

有没有办法创buildHasHorse属性的多个副本？ 说我想知道Farm的每个马厩里是否有一匹马

 Dim i As Long For i = 1 To SmithFarm.NumberOfStables SmithFarm.HasHorse(i) = True Next 

所以现在SmithFarm 将会有 Stable 1 ， Stable 2和Stable 3 – 所有的马都可以出租，并跟踪我在马场里有多less匹马 –

 Dim currentHorses As Long For i = 1 To SmithFarm.NumberOfStables If SmithFarm.HasHorse(i) Then currentHorses = currentHorses + 1 Next 

或者，也许我想看看第二个马厩是否有马 –

 Dim targetStable As Long targetStable = 2 If Not SmithFarm.HasHorse(targetStable) Then MsgBox "There's no horse here!" 

如何做到这一点？ 我知道上面的代码将无法正常工作 ，但有没有办法解决这个问题？ 我是否需要农场等级的马厩来使用？ 或者我是否需要一个存放在其他地方并以农场命名的马厩集合？

Answer 1

Array方法将迫使你处理“零状态”，而一个Dictionary方法可以让你更有效地处理马厩，通过包装它的成员和方法在你的类

如下所示

---

Farm类代码

 Option Explicit Public FarmName As String Private Stables As Scripting.Dictionary Public Property Get NumberOfStables() As Long NumberOfStables = Stables.Count End Property Public Sub AddStables(ByVal stablesNr As Long) Dim i As Long For i = 1 To stablesNr Stables.Add Stables.Count + 1, 0 Next End Sub Public Sub AddStable() Me.AddStables 1 End Sub Public Sub RemoveStable() If Stables.Count > 0 Then Stables.Remove Stables.Count End Sub Public Sub GetHorsesFromStable(ByVal stableNr As Long, ByVal horsesToRemove As Long) If Stables.Exists(stableNr) Then If horsesToRemove > 0 Then Stables(stableNr) = IIf(Stables(stableNr) - horsesToRemove >= 0, Stables(stableNr) - horsesToRemove, 0) End Sub Public Sub GetHorseFromStable(ByVal stableNr As Long) If Stables.Exists(stableNr) Then Me.GetHorsesFromStable stableNr, 1 End Sub Public Sub AddHorsesToStable(ByVal stableNr As Long, ByVal horsesToAdd As Long) If Stables.Exists(stableNr) Then If horsesToAdd > 0 Then Stables(stableNr) = Stables(stableNr) + horsesToAdd End Sub Public Sub AddHorseToStable(ByVal stableNr As Long) If Stables.Exists(stableNr) Then Me.AddHorsesToStable stableNr, 1 End Sub Public Property Get HasHorse(ByVal stableNr As Long) As Boolean If Stables.Exists(stableNr) Then HasHorse = Stables(stableNr) > 0 End Property Public Property Get stableHorses(ByVal stableNr As Long) As Long If Stables.Exists(stableNr) Then stableHorses = Stables(stableNr) End Property Public Property Get currentHorses() As Long Dim horses As Variant For Each horses In Stables.Items currentHorses = currentHorses + horses Next End Property Private Sub Class_Initialize() Set Stables = New Scripting.Dictionary End Sub 

---

你的Farm类剥削

 Option Explicit Sub FarmTest() Dim smithFarm As New Farm With smithFarm .AddStables 3 '<--| add stables Debug.Print .NumberOfStables '<--| returns three Debug.Print .currentHorses '<--| returns zero Debug.Print .HasHorse(1) '<--| returns False Debug.Print .HasHorse(2) '<--| returns False Debug.Print .HasHorse(3) '<--| returns False Debug.Print "" .AddHorsesToStable 1, 2 '<--| add stable 1 two horses Debug.Print .currentHorses '<--| returns two Debug.Print .HasHorse(1) '<--| returns True Debug.Print .stableHorses(1) '<--| returns two Debug.Print .HasHorse(2) '<--| returns False Debug.Print .stableHorses(2) '<--| returns zero Debug.Print "" .AddHorsesToStable 2, 1 '<--| add stable 2 one horse Debug.Print .currentHorses '<--| returns three Debug.Print .HasHorse(2) '<--| returns True Debug.Print .stableHorses(2) '<--| returns one Debug.Print .HasHorse(3) '<--| returns False Debug.Print .stableHorses(3) '<--| returns zero Debug.Print "" .AddHorsesToStable 3, 2 '<--| add stable 3 two horses Debug.Print .currentHorses '<--| returns five Debug.Print .HasHorse(3) '<--| returns True Debug.Print .stableHorses(3) '<--| returns three End With End Sub 

Answer 2

你可以让HasHorse成为一个布尔数组。 但是你将面临一个问题，那就是你需要让你的数组的大小与NumberOfStables属性保持一致。 因此，不要pipe理NumberOfStables本身，只是一个返回数组大小的getter 。 这是你的class级的制定者和获得者的需要。

 ' Code for the Farm Class Option Explicit Public FarmName As String Private mStables() As Boolean Public Property Get NumberOfStables() As Long NumberOfStables = UBound(mStables) End Property Public Property Let NumberOfStables(ByVal n As Long) ReDim Preserve mStables(1 To n) End Property Public Property Get HasHorse(ByVal i As Long) As Boolean HasHorse = mStables(i) End Property Public Property Let HasHorse(ByVal i As Long, ByVal b As Boolean) mStables(i) = b End Property Public Property Get currentHorses() As Long Dim i As Long For i = 1 To NumberOfStables If HasHorse(i) Then currentHorses = currentHorses + 1 Next End Property 

这里是一些testing，在一个正常的代码模块：

 Sub FarmTesting() Dim smithFarm As New Farm smithFarm.NumberOfStables = 3 Debug.Print smithFarm.NumberOfStables smithFarm.HasHorse(2) = True Debug.Print smithFarm.HasHorse(1), smithFarm.HasHorse(2), smithFarm.HasHorse(3) smithFarm.NumberOfStables = 2 Debug.Print smithFarm.HasHorse(1), smithFarm.HasHorse(2) Debug.Print smithFarm.currentHorses End Sub 

Answer 3

ASH的答案会很好，是Property Let和Property Get一个很好的例子。

OOP的纯粹主义者可能会说你需要两个阶级： Farm和Stables 。 这真的取决于你的结构将变得多么复杂。 下面是一个非常基本的两类结构，你可以从这里开始：

Farm类（叫做clsFarm ）：

 Public FarmName As String Public Stables As Collection Public Property Get HorseCount() As Long Dim oStable As clsStable If Not Me.Stables Is Nothing Then For Each oStable In Me.Stables If oStable.HasHorse Then HorseCount = HorseCount + 1 End If Next End If End Property Public Property Get Stable(stableRef As String) As clsStable Set Stable = Stables(stableRef) End Property 

Stable类（称为clsStable ）：

 Public StableRef As String Public HasHorse As Boolean 

你可以填充模块中的类：

 Dim oFarm As clsFarm Dim oStable As clsStable Set oFarm = New clsFarm With oFarm .FarmName = "Smith Farm" Set .Stables = New Collection End With Set oStable = New clsStable With oStable .StableRef = "1" .HasHorse = True End With oFarm.Stables.Add oStable, oStable.StableRef Set oStable = New clsStable With oStable .StableRef = "2" .HasHorse = False End With oFarm.Stables.Add oStable, oStable.StableRef Set oStable = New clsStable With oStable .StableRef = "3" .HasHorse = True End With oFarm.Stables.Add oStable, oStable.StableRef 

然后根据需要操纵数据，例如：

 MsgBox oFarm.HorseCount If Not oFarm.Stable("2").HasHorse Then MsgBox "Bolted!" 

Answer 4

这可以通过使用两个类来完成：cFarm和cHorse， 通过使cHorse成为cFarm的一个属性

马厩被存储在一个字典中，这也是cFarm类的一个属性。 由于此字典， 您必须添加Microsoft脚本运行时参考库 。

使用以下类的示例：

• 创build一个农场
• 加10个马厩
• 用马匹填满马厩（所有的马厩都是有马的）
• 把马从马厩里拿出来（你可以写另外一个把马放回马厩的function）
• 打印出马厩的列表，马上是否有马

马在这个例子中被命名。

这个子进入一个标准的模块。

 Sub CreateFarm() Dim clsFarm As New cFarm With clsFarm .FarmName = "Smith Farm" .AddStables 10 .TakeHorseOutOfStable 2 .TakeHorseOutOfStable 5 .TakeHorseOutOfStable 6 .TakeHorseOutOfStable 9 .PrintStableHorseState End With End Sub 

从CreateFarm子输出

cFarm类

cHorse类（在这个类下面定义）是这个（cFarm）类的一个属性。 马厩被储存在字典中，这也是这个类的一个属性。 这些属性由类初始化程序设置。

 Option Explicit Private pFarmName As String Private pdictStables As Scripting.Dictionary ' requires Microsoft Scripting Runtime library Private pHorse As cHorse Private pNumStables As Integer Public Property Get FarmName() As String FarmName = pFarmName End Property Public Property Let FarmName(ByVal sFarmName As String) pFarmName = sFarmName End Property Public Property Get dictStables() As Scripting.Dictionary Set dictStables = pdictStables End Property Public Property Set dictStables(ByVal dStable As Scripting.Dictionary) Set pdictStables = dStable End Property Public Property Get Horse() As cHorse Set Horse = pHorse End Property Public Property Set Horse(ByVal clsHorse As cHorse) Set pHorse = clsHorse End Property Public Property Get NumStables() As Integer NumStables = pNumStables End Property Public Property Let NumStables(ByVal iNumStables As Integer) pNumStables = iNumStables End Property Sub AddStables(intNumStables As Integer) ' all stables are initialized to have a horse Dim i As Integer With Me .NumStables = intNumStables For i = 1 To .NumStables Set .Horse = New cHorse With .Horse .HorseName = .HorseNames(i) .HasHorse = True End With .dictStables.Add i, .Horse Next i End With End Sub Sub TakeHorseOutOfStable(intStableNum As Integer) With Me Set .Horse = .dictStables(intStableNum) .Horse.HasHorse = False Set .dictStables(intStableNum) = .Horse End With End Sub Sub PrintStableHorseState() Dim vStable As Variant With Me.dictStables For Each vStable In .Keys Debug.Print "Stable number: " & vStable & _ " Horse Name: " & .Item(vStable).HorseName & _ " HasHorse: " & .Item(vStable).HasHorse Next vStable End With End Sub Private Sub Class_Initialize() Dim clsHorse As cHorse Dim dict As Scripting.Dictionary Set clsHorse = New cHorse Set Me.Horse = clsHorse Set dict = New Scripting.Dictionary Set Me.dictStables = dict End Sub 

cHorseclass

 Option Explicit Private pHasHorse As Boolean Private pHorseName As String Private pHorseNames As Collection Public Property Get HasHorse() As Boolean HasHorse = pHasHorse End Property Public Property Let HasHorse(ByVal bHasHorse As Boolean) pHasHorse = bHasHorse End Property Public Property Get HorseName() As String HorseName = pHorseName End Property Public Property Let HorseName(ByVal sHorseName As String) pHorseName = sHorseName End Property Public Property Get HorseNames() As Collection Set HorseNames = pHorseNames End Property Public Property Set HorseNames(ByVal colHorseNames As Collection) Set pHorseNames = colHorseNames End Property Private Function GetHorseNames() As Collection Dim colHorseNames As New Collection With colHorseNames .Add "Secretariat" .Add "Man O' War" .Add "Seabiscuit" .Add "Phar Lap" .Add "Frankel" .Add "Black Caviar" .Add "Ruffian" .Add "Citation" .Add "Zenyatta" .Add "Seattle Slew" End With Set GetHorseNames = colHorseNames End Function Private Sub Class_Initialize() Dim colHorseNames As New Collection Set Me.HorseNames = GetHorseNames() End Sub