Excel VBA:自定义集合重复项

Excel VBA: custom collection duplicated items

我创建了一个 class,其中包含一个自定义集合 class。当父项 class 初始化时,集合 class 中充满了项。问题是当我遍历集合的项目时,所有项目都具有最后添加的项目的属性。这些项目应该与 ActiveSheet 中的单元格相关联,每个项目都有一个 Name 和 Range 属性。 Name 是单元格的值,Range 是范围。因此,在单元格 A1:D1 中,我有值 ID、Q1、Q2、Q3,当我创建父级 class 的实例时,我希望集合的成员具有名称 ID、Q1、Q2、Q3 和范围 A1、B1、C1、D1。但是,当我迭代时,输出显示 Q3、Q3、Q3、Q3 和 $D$1、$D$1、$D$1、$D$1。

问题出在哪里?

代码如下:

Sub test()

    Dim Sample As Sample
    Set Sample = New Sample

    Dim fld As New Field

    For Each fld In Sample.Fields
        Debug.Print fld.Name; vbTab; fld.Range.Address
    Next

End Sub

领域class:

Private pName As String
Private pRange As Range

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

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

Public Property Set Range(rng As Range)
    Set pRange = rng
End Property

Public Property Get Range() As Range
    Set Range = pRange
End Property

字段class(自定义集合):

Private pFields As Collection

Private Sub Class_Initialize()
    Set pFields = New Collection
End Sub

Private Sub Class_Terminate()
    Set pFields = Nothing
End Sub

Public Function NewEnum() As IUnknown
    Set NewEnum = pFields.[_NewEnum]
End Function

Public Sub Add(fld As Field)
    pFields.Add fld
End Sub

Public Sub Remove(Index As Variant)
    pFields.Remove Index
End Sub

Public Property Get Item(Index As Variant) As Field
    Set Item = pFields.Item(Index)
End Property

Property Get Count() As Long
    Count = pFields.Count
End Property

Public Sub Clear()
    Set pFields = New Collection
End Sub

和示例 class(包含字段集合 class):

Private pFields As Fields

Private Sub Class_Initialize()
    Set pFields = New Fields
    Initialize_Fields
End Sub

Private Sub Class_Terminate()
    Set pFields = Nothing
End Sub

Public Property Get Fields() As Fields
    Set Fields = pFields
End Property

Private Sub Initialize_Fields()

    Dim rngHeaders As Range, rngCell As Range
    Set rngHeaders = Range("A1").CurrentRegion.Rows(1)

    For Each rngCell In rngHeaders.Cells
        Dim NewField As New Field
        NewField.Name = rngCell.Value2
        Set NewField.Range = rngCell

        pFields.Add NewField
    Next rngCell

End Sub

问题已解决。

改变了这个:

For Each rngCell In rngHeaders.Cells
    Dim NewField As New Field
    NewField.Name = rngCell.Value2
    Set NewField.Range = rngCell

    pFields.Add NewField
Next rngCell

为此:

Dim NewField As Field

For Each rngCell In rngHeaders.Cells
    Set NewField = New Field

    NewField.Name = rngCell.Value2
    Set NewField.Range = rngCell

    pFields.Add NewField
Next rngCell