Question

假设我创建了一个名为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

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

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

所以现在SmithFarm 会有 Stable 1，Stable 2和Stable 3 - 所有马匹都可以出租并跟踪我在农场马厩里养了很多匹马 -

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

您可以将HasHorse设为布尔数组。但是您将面临一个问题，即您需要使数组的大小与NumberOfStables属性一致。因此，不管理NumberOfStables属性，只返回返回数组大小的getter。这就是你们班级的制定者和吸气者需要的地方。

' 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

这是一些测试，在正常的代码模块中：

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 2

A.S.H.的答案很有效，是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 3

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 4

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

稳定存储在字典中，字典也是cFarm类的属性。 由于此词典，您必须添加Microsoft Scripting Runtime参考库。

使用类的示例：

创建一个农场
添加10个马厩
用马匹填充马厩（所有的马厩都是马匹的）“
将马从一些马厩中取出（你可以写另一个功能，将马放回马厩）
打印（到即时窗口）马厩列表以及是否有马匹

在这个例子中命名马。

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

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 sub

的输出

cFarm Class

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

cHorse class

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

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

4 个答案:

使用类的示例：

CreateFarm sub

cFarm Class

cHorse class