Question

我有这个定义：

Type Linea
    name As String
    color As Long
End Type

Type lineas
    from As Integer
    to As Integer
    lineas() As Linea
End Type

我如何实例化一个“lineas”变量，像正确的VBA代码中的伪代码一样分配几行？

Sub colours()
    Dim lineas_CMTS As lineas

    lineas_CMTS.from = 200
    lineas_CMTS.to = 219
    lineas_CMTS.lineas() = New Linea {name="Cisco", color=RGB(0,50,100)}
    lineas_CMTS.lineas() = New Linea {name="Huawei", color=RGB(50,0,100)}

End Sub

Answer 1

正如@Alex K所说，你写这两个结构时没办法

但你可以考虑一种解决方法，用Linea替换Array类型

Type lineas
    from As Integer
    to As Integer
    lineas() As Variant ' use a variant type instead of a "Linea" one
End Type

Sub colours()
    Dim lineas_CMTS As lineas

    With lineas_CMTS
        .from = 200
        .to = 219
        ReDim .lineas(0 To 1) 
        .lineas(0) = Array("Cisco", RGB(0, 50, 100))
        .lineas(1) = Array("Huawei", RGB(50, 0, 100))
    End With
End Sub

如果您事先已经知道ReDim .lineas(0 To 1)数组维度

，则可以避免lineas()

Type lineas
    from As Integer
    to As Integer
    lineas(0 To 1) As Variant
End Type


Sub colours()
    Dim lineas_CMTS As lineas

    With lineas_CMTS
        .from = 200
        .to = 219
        .lineas(0) = Array("Cisco", RGB(0, 50, 100))
        .lineas(1) = Array("Huawei", RGB(50, 0, 100))
    End With
End Sub

Answer 2

一种可能的解决方案是定义两个类并引用它们。类LineaCollection持有类Linea的集合。因此，您可以在以下模块中引用它们：

Public Sub TestMe()

    Dim lineasCMTS As New LineasCollection

    lineasCMTS.From = 200
    lineasCMTS.ToV = 219

    lineasCMTS.AddValue RGB(0, 50, 100), "Cisco"
    lineasCMTS.AddValue RGB(0, 50, 101), "Huawei"

    Dim cnt As Long
    For cnt = 1 To lineasCMTS.InfoCollection.Count
        Debug.Print lineasCMTS.InfoCollection(cnt).Name
        Debug.Print lineasCMTS.InfoCollection(cnt).Color
    Next cnt

End Sub

这些类的想法是，Linea具有Name和Color属性，包括用于创建自身的factory design patter：

Option Explicit

Private m_sName As String
Private m_lColor As Long

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

Public Property Get Color() As Long    
    Color = m_lColor    
End Property

Public Property Let Color(ByVal lNewValue As Long)    
    m_lColor = lNewValue    
End Property

Public Property Let Name(ByVal sNewValue As String)    
    m_sName = sNewValue    
End Property

Public Sub CreateLinea(newObj As Linea, newColor As Long, newName As String)        
    newObj.Name = newName
    newObj.Color = newColor        
End Sub

LineasCollection具有AddValue，AddToCollection方法，这些方法与Linea类或外部模块进行通信。 From和To是属性，InfoCollection可以访问整个集合：

Option Explicit

Private m_lFrom             As Long
Private m_lTov              As Long
Private m_cLineasCollection As New Collection

Public Property Get InfoCollection() As Collection
    Set InfoCollection = m_cLineasCollection
End Property

Public Property Get From() As Long
    From = m_lFrom
End Property

Public Property Get ToV() As Long
    ToV = m_lTov
End Property

Public Property Let ToV(ByVal lNewValue As Long)
    m_lTov = lNewValue
End Property

Public Property Let From(ByVal lNewValue As Long)
    m_lFrom = lNewValue
End Property

Public Sub AddToCollection(newObj As Linea)
    m_cLineasCollection.Add newObj
End Sub

Public Sub AddValue(colorNew As Long, nameNew As String)
    Dim newObj  As New Linea
    newObj.CreateLinea newObj, colorNew, nameNew
    AddToCollection newObj
End Sub

VBA：在用户对象定义中分配动态数组

2 个答案: