Коллекции классов в VBA


Я заметил этот вопрос https://stackoverflow.com/questions/49389392/nested-classes-and-collections-vba в сайте StackOverflow, но его закрыли быстрее, чем я мог бы ответить. Однако, это было относительно лучшей практики для использования сборников классов.

Я обычно использую Array и я добавляю к ней такой:

Public Sub AddToTeam(emp As Employee)

    Dim cnt As Long
    cnt = UBound(pTeam)

    If Not pTeam(0) Is Nothing Then
        ReDim Preserve pTeam(cnt + 1)
        cnt = cnt + 1
    End If
    Set pTeam(cnt) = emp

End Sub

Кроме того, я инициализировать массив, как это в классе:

Private Sub Class_Initialize()
    ReDim pTeam(0)
End Sub

Это рабочий код, не стесняйтесь, чтобы дать какие-то идеи:

Основной Модуль

Option Explicit

Public Sub TestMe()

    Dim EmpA    As New Employee
    Dim EmpB    As New Employee
    Dim ManA    As New Employee
    Dim TeamA   As New Team

    ManA.Name = "John Doe Top Manager"
    EmpA.Name = "Peter"
    EmpB.Name = "George"

    Set EmpB.Manager = ManA
    TeamA.Name = "The best team!"

    TeamA.AddToTeam ManA
    TeamA.AddToTeam EmpA
    TeamA.AddToTeam EmpB

    TeamA.PrintNames
    Debug.Print TeamA.Name
    TeamA.PrintInfoForManagers

End Sub

Сотрудник Класса

Option Explicit

Private pName           As String
Private pManager        As Employee
Private pAge            As Long
Private pTeam           As String
Private pHasManager     As Boolean

Public Property Get HasManager() As Boolean
    HasManager = pHasManager
End Property

Public Property Let HasManager(Value As Boolean)
    pHasManager = Value
End Property

Public Property Get Manager() As Employee
    Set Manager = pManager
End Property

Public Property Set Manager(Value As Employee)
    Set pManager = Value
    HasManager = True
End Property

Public Property Get Name() As String
    Name = pName
End Property

Public Property Let Name(Value As String)
    pName = Value
End Property

Public Property Get Team() As Employee
    Team = pTeam
End Property

Public Property Let Team(Value As Employee)
    pTeam = Value
End Property

Класс Команды

Option Explicit

Private pTeam()         As Employee
Private pName           As String

Public Sub PrintInfoForManagers()

    Dim emp As Variant
    For Each emp In pTeam
        If emp.HasManager Then
            Debug.Print emp.Name & " is managed by " & emp.Manager.Name
        Else
            Debug.Print emp.Name & " has no manager."
        End If
    Next emp

End Sub

Public Sub PrintNames()

    Dim emp As Variant
    For Each emp In pTeam
        Debug.Print emp.Name
    Next emp

End Sub

Public Property Get Name() As String
    Name = pName
End Property

Public Property Let Name(Value As String)
    pName = Value
End Property

Public Sub AddToTeam(emp As Employee)

    Dim cnt As Long
    cnt = UBound(pTeam)

    If Not pTeam(0) Is Nothing Then
        ReDim Preserve pTeam(cnt + 1)
        cnt = cnt + 1
    End If
    Set pTeam(cnt) = emp

End Sub

Private Sub Class_Initialize()
    ReDim pTeam(0)
End Sub

Так что как бы вы обзор/улучшить?



160
1
задан 20 марта 2018 в 05:03 Источник Поделиться
Комментарии
2 ответа

Я предпочитаю не начинать массивы, пока они не нужны. Автоматическое инициирование Ваш массив может сделать это трудно определить, является ли массив был использован. С помощью Team классу, как пример, называя PrintNames перед любыми именами добавляются выдаст сообщение об ошибке.

Private Sub Class_Initialize()
ReDim pTeam(0)
End Sub

Основная причина это сделано, чтобы избежать ошибки при проверке, является ли массив был инициализирован.

Существует трюк, чтобы избежать ошибки 9, Subscript out of range. Проверка, чтобы увидеть, если массив IsEmpty() на неинициализированный массив вызовет UBound() вернуть -1.

С помощью Call IsEmpty(pTeam) вместо ReDim pTeam(0) мы можем легко проверить, является ли массив фактически был использован, используя If UBound(pTeam) = -1 Then.

Private Sub Class_Initialize()
Call IsEmpty(pTeam)
End Sub

Public Sub AddToTeam(emp As Employee)
If UBound(pTeam) = -1 Then
ReDim pTeam(0)
Else
ReDim Preserve pTeam(UBound(pTeam) + 1)
End If
Set pTeam(UBound(pTeam)) = emp
End Sub

Кроме того, мы могли бы написать функцию, чтобы проверить, если массив был использован.

Public Function hasMembers()
Call IsEmpty(pTeam)
hasMembers = UBound(pTeam) > -1
End Function

Используя частный тип для ссылки на члены класса

Матье лесопарк guindon (Формально известный как Мата Харя) любит использовать пользовательский тип данных (UDT) имени This для ссылки на класс уровень переменных. Я принял технику, но имя его vars вместо This. Таким образом, вы можете избежать того, чтобы имена переменных класса отличается от названия параметра (см. код ниже).

Рефакторинг Кода

Сотрудник:Класс

Option Explicit

Private Type Variables
Name As String
Manager As Employee
Age As Long
Team As String
End Type

Private vars As Variables

Public Function HasManager() As Boolean
HasManager = Not vars.Manager Is Nothing
End Function

Public Property Get Manager() As Employee
Set Manager = vars.Manager
End Property

Public Property Set Manager(Value As Employee)
Set vars.Manager = Value
End Property

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

Public Property Let Name(Value As String)
vars.Name = Value
End Property

Public Property Get Team() As Employee
Team = vars.Team
End Property

Public Property Let Team(Value As Employee)
vars.Team = Value
End Property

Public Function This() As Team
Set This = Me
End Function

Команда:Класс

Option Explicit

Private Type Variables
Team() As Employee
Name As String
End Type
Private vars As Variables

Public Sub PrintInfoForManagers()

Dim emp As Variant
For Each emp In vars.Team
If emp.HasManager Then
Debug.Print emp.Name & " is managed by " & emp.Manager.Name
Else
Debug.Print emp.Name & " has no manager."
End If
Next emp

End Sub

Public Sub PrintNames()
Dim emp As Variant
If UBound(vars.Team) = -1 Then
Debug.Print "There are no Names to Print"
Else
For Each emp In vars.Team
Debug.Print emp.Name
Next emp
End If

End Sub

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

Public Property Let Name(Value As String)
vars.Name = Value
End Property

Public Sub AddToTeam(emp As Employee)
If Not Me.hasMembers Then
ReDim vars.Team(0)
Else
ReDim Preserve vars.Team(UBound(vars.Team) + 1)
End If
Set vars.Team(UBound(vars.Team)) = emp
End Sub

Public Function hasMembers()
Call IsEmpty(vars.Team)
hasMembers = UBound(vars.Team) > -1
End Function

Public Function This() As Team
Set This = Me
End Function

2
ответ дан 21 марта 2018 в 09:03 Источник Поделиться

Я не вижу необходимости HasManager собственность. Либо Manager назначается, или нет. Это не имеет смысла для вас, чтобы установить его в true, когда его нет, или false, если нет.

Затем просто изменить свой Print функция проверки -

If Not emp.Manager Is Nothing Then
Debug.Print emp.Name & " is managed by " & emp.Manager.Name
Else
Debug.Print emp.Name & " has no manager."

Если бы это было легко перегрузить инициализации класса для работника, я бы сказал, сделать имя параметра обязателен, но это действительно не простая задача в VBA.


Эти два свойства:


Public Property Get Team() As Employee
Team = pTeam
End Property

Public Property Let Team(Value As Employee)
pTeam = Value
End Property


Проходят Objects - почему не проходит Strings дали команду информация обрабатывается строка.

2
ответ дан 20 марта 2018 в 09:03 Источник Поделиться