VBA类模块集合属性编译错误（Argument Not Optional）排查与解决

问题场景 #

我创建了名为Melted的类模块，核心代码如下：

Option Explicit
Private Type Melted
    CommonID As String
    Longdata1 As Collection
    Longdata2 As Collection
End Type
Private this As Melted

Public Property Get Longdata1() As Collection '调试器高亮此行
    Longdata1 = this.Longdata1
End Property
Public Property Let Longdata1(ByVal value As Collection)
    Set this.Longdata1 = value
End Property

Public Sub Class_Initialize()
    Set this.Longdata1 = New Collection
    Set this.Longdata2 = New Collection
End Sub

在另一个标准模块中执行以下代码，尝试向Longdata集合添加数据：

Private AllMelted As Object
Private CommonIDs As Collection
Public Property Get GetID() As String '用Get是因为不需要参数
    Dim Nextup As String
    Nextup = CommonIDs.Item(CommonIDs.Count)
    CommonIDs.Remove CommonIDs.Count
    GetID = Nextup
End Property
Public Property Get Melteds() As Object
    Melteds = AllMelted
'仅通过此属性访问字典
End Property
Public Property Get Reset() As Boolean
    AllMelted = Nothing
    CommonIDs = Nothing
    Reset = True
End Property

Function ProcessRow(ByVal CurrentRow As Range) As Integer
    If Not AllMelted.Exists(CurrentRow.Cells(1).Value) Then
        CommonIDs.Add CurrentRow.Cells(1).Value
        Dim Currmelt As Melted
        Set Currmelt = New Melted
        Currmelt.Class_Initialize
        Currmelt.CommonID = CurrentRow.Cells(1).Value
        Currmelt.Longdata1.Add CurrentRow.Cells(2).Value '错误发生在此行，前序步骤正常
        Currmelt.Longdata2.Add CurrentRow.Cells(3).Value
        AllMelted.Add CurrentRow.Cells(1).Value, Currmelt
    Else
        AllMelted(CurrentRow.Cells(1).Value).Longdata1.Add CurrentRow.Cells(2).Value
        AllMelted(CurrentRow.Cells(1).Value).Longdata2.Add CurrentRow.Cells(3).Value
    End If
    ProcessRow = CommonIDs.Count
End Function

Sub Preprocess()
    AllMelted = CreateObject("scripting.dictionary")
    Set CommonIDs = New Collection
    For Each Row In ActiveSheet.Rows
        Dim Progress As Integer
        Progress = ProcessRow(Row)
    Next Row
End Sub

执行到Currmelt.Longdata1.Add CurrentRow.Cells(2).Value时触发编译错误，调试器高亮类模块中Public Property Get Longdata1() As Collection行。

补充说明：我正在处理聚合数据，将每个聚合项以Melted类型存储在字典中，若聚合ID已存在则向对应集合添加数据，AllMelted和CommonIDs设为私有用于后续子过程调用。

错误原因 #

1. 集合对象赋值未用Set关键字：在Longdata1的Get属性中，直接用Longdata1 = this.Longdata1赋值集合对象。VBA中对象类型的赋值必须使用Set关键字，否则会尝试复制对象的值而非引用，触发编译错误。
2. 属性类型不匹配：集合是对象类型，对应的属性设置应该用Property Set而非Property Let。Let用于值类型赋值，Set才是对象类型的赋值方式，当前的Property Let Longdata1定义错误。
3. 手动调用Class_Initialize：创建类实例Set Currmelt = New Melted时，VBA会自动调用Class_Initialize初始化过程，手动调用会重复初始化，可能导致集合对象状态异常。
4. 字典等对象赋值未用Set：AllMelted = CreateObject("scripting.dictionary")、Melteds = AllMelted、AllMelted = Nothing这些对象赋值都缺少Set关键字，会引发错误。
5. 字典Add方法参数顺序错误：原代码中AllMelted.Add CurrentRow.Cells(1).Value, Currmelt把Item放在Key前面，不符合字典Add(Key, Item)的参数规则。

解决方法 #

1. 修正Melted类模块代码 #

Option Explicit
Private Type Melted
    CommonID As String
    Longdata1 As Collection
    Longdata2 As Collection
End Type
Private this As Melted

' 修正Get属性：对象赋值用Set
Public Property Get Longdata1() As Collection
    Set Longdata1 = this.Longdata1
End Property
' 替换Property Let为Property Set，适配对象类型赋值
Public Property Set Longdata1(ByVal value As Collection)
    Set this.Longdata1 = value
End Property

' 补充Longdata2的完整属性定义
Public Property Get Longdata2() As Collection
    Set Longdata2 = this.Longdata2
End Property
Public Property Set Longdata2(ByVal value As Collection)
    Set this.Longdata2 = value
End Property

' 补充CommonID的完整属性定义
Public Property Get CommonID() As String
    CommonID = this.CommonID
End Property
Public Property Let CommonID(ByVal value As String)
    this.CommonID = value
End Property

Public Sub Class_Initialize()
    Set this.Longdata1 = New Collection
    Set this.Longdata2 = New Collection
End Sub

2. 修正标准模块代码 #

Private AllMelted As Object
Private CommonIDs As Collection

Public Property Get GetID() As String
    Dim Nextup As String
    ' 增加空集合判断，避免索引越界
    If CommonIDs.Count > 0 Then
        Nextup = CommonIDs.Item(CommonIDs.Count)
        CommonIDs.Remove CommonIDs.Count
    End If
    GetID = Nextup
End Property

' 修正对象赋值用Set
Public Property Get Melteds() As Object
    Set Melteds = AllMelted
End Property

Public Property Get Reset() As Boolean
    Set AllMelted = Nothing
    Set CommonIDs = Nothing
    Reset = True
End Property

Function ProcessRow(ByVal CurrentRow As Range) As Integer
    ' 跳过空行，避免无效处理
    If CurrentRow.Cells(1).Value = "" Then
        ProcessRow = CommonIDs.Count
        Exit Function
    End If
    
    Dim key As String
    key = CurrentRow.Cells(1).Value
    
    If Not AllMelted.Exists(key) Then
        CommonIDs.Add key
        Dim Currmelt As Melted
        Set Currmelt = New Melted
        ' 移除手动调用Class_Initialize
        Currmelt.CommonID = key
        Currmelt.Longdata1.Add CurrentRow.Cells(2).Value
        Currmelt.Longdata2.Add CurrentRow.Cells(3).Value
        ' 修正字典Add方法的参数顺序：Key在前，Item在后
        AllMelted.Add key, Currmelt
    Else
        Dim existingMelt As Melted
        Set existingMelt = AllMelted(key)
        existingMelt.Longdata1.Add CurrentRow.Cells(2).Value
        existingMelt.Longdata2.Add CurrentRow.Cells(3).Value
    End If
    ProcessRow = CommonIDs.Count
End Function

Sub Preprocess()
    ' 修正对象赋值用Set
    Set AllMelted = CreateObject("scripting.dictionary")
    Set CommonIDs = New Collection
    
    Dim lastRow As Long
    ' 获取有效数据行，避免遍历所有空行
    lastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
    
    Dim Row As Range
    For Each Row In ActiveSheet.Range("A1:A" & lastRow).EntireRow
        Dim Progress As Integer
        Progress = ProcessRow(Row)
    Next Row
End Sub

关键修正点总结 #

• 所有对象类型（集合、类实例、字典）的赋值必须使用Set关键字。
• 对象类型的属性设置要用Property Set，值类型用Property Let。
• 类实例创建时New关键字会自动触发Class_Initialize，无需手动调用。
• 字典Add方法的参数顺序为Key, Item，不可颠倒。
• 遍历行时限制为有效数据行，避免处理大量空行引发异常。

内容的提问来源于stack exchange，提问作者DIS