VBA中ArrayList添加自定义对象出现覆盖异常问题排查

开发Excel宏处理财务条目时出现异常：解析阶段输出正常，但将条目存入ArrayList后读取时，条目数不稳定，新条目频繁覆盖所有旧条目。简化测试案例中，预期生成包含10条工时（1到10）的条目，但实际仅保留最后1条工时为10的记录。

复现代码 #

测试过程代码 #

Sub DebugTest()
    Dim task As New sTask
    Dim this_charge As New sCharge
    For i = 1 To 10
        this_charge.wbs_element = this_wbs
        this_charge.nwa = "NWA123456"
        this_charge.nwa_title = "TEST NWA"
        this_charge.name = "ADAM WEST"
        this_charge.post_date = "03/15/2024"
        this_charge.hours = i
        this_charge.log_date = "03/14/2024"
        this_charge.labor_cost = "100"
        Call task.AddLaborCharge(this_charge)
    Next i
    task.ProcessLaborCharges
End Sub

sTask类模块代码 #

' Class Module: sTask

Dim laborcharge_array As New ArrayList

Public Sub AddLaborCharge(charge As sCharge)
    laborcharge_array.Add charge
End Sub

Public Sub ProcessLaborCharges()
    Dim charge As sCharge
    Dim employee As sEmployee
    For Each charge In laborcharge_array
        Set employee = GetEmployee(charge.name)
        Dim employee_charges As Worksheet
        Set employee_charges = ThisWorkbook.Worksheets(charge.name)
        Dim next_row As Integer
        next_row = employee_charges.Cells(Rows.count, 1).End(xlUp).Row + 1
        employee_charges.Cells(next_row, 1).Value = charge.wbs_element
        employee_charges.Cells(next_row, 2).Value = charge.nwa
        employee_charges.Cells(next_row, 3).Value = charge.nwa_title
        employee_charges.Cells(next_row, 4).Value = charge.hours
        employee_charges.Cells(next_row, 5).Value = charge.labor_cost
        employee_charges.Cells(next_row, 6).Value = charge.log_date
        employee_charges.Cells(next_row, 7).Value = charge.post_date
    Next charge
End Sub

问题原因 #

VBA中对象属于引用类型，你在循环外仅创建了一个sCharge实例，循环过程中只是反复修改该实例的属性值，ArrayList中添加的都是同一个对象的引用。最终所有元素指向的都是最后一次循环修改后的实例，导致看起来所有旧条目被覆盖。

解决方案 #

在循环内部每次创建新的sCharge实例，确保每次添加到ArrayList的是独立的对象：

Sub DebugTest()
    Dim task As New sTask
    Dim this_charge As sCharge ' 仅声明变量，不初始化
    For i = 1 To 10
        Set this_charge = New sCharge ' 循环内每次创建新实例
        this_charge.wbs_element = this_wbs
        this_charge.nwa = "NWA123456"
        this_charge.nwa_title = "TEST NWA"
        this_charge.name = "ADAM WEST"
        this_charge.post_date = "03/15/2024"
        this_charge.hours = i
        this_charge.log_date = "03/14/2024"
        this_charge.labor_cost = "100"
        Call task.AddLaborCharge(this_charge)
    Next i
    task.ProcessLaborCharges
End Sub

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