arrays - 在 VBA 中确定未初始化数组的类型

Question

我想编写一个函数，当给定用户定义类的已声明但未初始化的数组时，该函数将识别该数组旨在保存的对象类型，然后为该数组创建新对象。 我有一个名为“clsNewSector”的类，并在另一个类中声明一个数组，如下所示:

Private pSectors(1 To 3) As clsNewSector

然后我有一个函数应该能够识别虽然每个对象目前都引用“Nothing”，但它应该能够获取数组的类型，在本例中是 clsNewSector，但在其他情况下类类型可能会改变。

Function InitializeObjectArray(a As Variant) As Variant
Dim NameofType As String
NameOfType = TypeName(a(1))
For i = LBound(a) To UBound(a)
    Set a(i) = NewObject(NameOfType)
Next i
End Function

typename 函数不起作用，因为它只返回“Nothing”，因为数组未初始化，它无法识别变量是否被声明为不同的类型。有没有办法找到未初始化数组的声明类型，以便我可以使用 for 循环使用正确类型的新对象来初始化数组的每个成员。

Answer 1

OP 提出的问题本质上是关于初始化一个对象，该对象(在本例中)是 clsNewSector 的集合。

实现此目的的一个简单方法是将 scripting.dictionary 包装在强类型类中。

下面的代码适用于名为 clsNewSectors 的对象，它将创建一个包含脚本字典的对象，该脚本字典包含三个 clsNewSector 对象。

脚本字典的 Item 属性是强类型的，因此我们只能添加、设置或获取 clsNewSector 对象。

如果您检查下面的代码，您会发现它可以通过仅在 ClsNewSector 上进行搜索和替换来重新用于不同的对象(假设整数长 key 仍然可以接受)

clsNewSectors 类

Option Explicit

Private Type State
    
    Host As Scripting.dictionary
    
End Type

Private s As State



Private Sub Class_Initialize()

    Set s.Host = New Scripting.dictionary
    
    With s.Host
    
        .Add .Count, New clsNewSector
        .Add .Count, New clsNewSector
        .Add .Count, New clsNewSector
        
    End With
    
End Sub

Public Property Get Item(ByVal ipIndex As Long) As clsNewSector

    If s.Host.exists(ipIndex) Then
    
        Set Item = s.Host.Item(ipIndex)
        
    Else
    
        Err.Raise 381, "Invalid index", "The index does not exist"
        
    End If
        
End Property


Public Property Set Item(ByVal ipIndex As Long, ByVal ipValue As clsNewSector)

    ' Avoid creating a dictionary entry by assignment
    If s.Host.exists(ipIndex) Then
    
        Set s.Host.Item(ipIndex) = ipValue
        
    Else
    
        Err.Raise 381, "Invalid index", "The index does not exist"
        
    End If
        
End Property

Public Sub Add(ByVal ipKey As Long, ByVal ipItem As clsNewSector)

    If s.Host.exists(ipKey) Then
    
        Err.Raise 457, "Key error", "A value is already associated with the key"
        
    End If
    
    s.Host.Add ipKey, ipItem
    
End Sub

Public Function Keys() As Variant

    Keys = s.Host.Keys
    
End Function

Public Function Items() As Variant

    Items = s.Host.Items
    
End Function

OP原始代码现在可以替换为

Private pSectors As clsNewSectors
Set pSectors = new clsNewSectors

上面的想法可以扩展以增加更多的灵活性(例如多种类型对象的工厂)，但这是一个单独的讨论。

上面的代码编译正常，并且不会生成任何有意义的 RUbberduck 检查。

上面的代码需要引用 Microsoft Scripting RUntime。