Excel宏强制停止后内存清理卡顿，如何快速重定义字典？

我在Excel中实现了状态相关功能，通过一个名为State的独立模块维护多个顶层公共Dictionary，将大量自定义类clsData对象（存储工作表数据）填充到这些字典中。宏正常运行后Excel占用2GB内存属于正常情况，但强制终止宏后Excel会长时间冻结（最长达300秒），推测是Excel在逐个清理内存中50余个、部分含20万元素的字典导致。常规优化（手动计算、关闭屏幕更新）无效，希望重新运行宏时能快速重定义字典，跳过旧数据清理的漫长等待。

相关代码示例 #

状态模块（独立模块） #

Public Dict1 As Dictionary
Public Dict2 As Dictionary

' 持久化工作表数据
Public Dict3 As Dictionary
Public Dict4 As Dictionary

' 持久化对象重命名信息
Public Dict5 As Dictionary
Public Dict6 As Dictionary
Public Dict7 As Dictionary

类模块 clsData #

Public Name As String
Public Prop1 As String

Public Prop2 As Integer
Public Prop3 As Date
Public Prop4 As String

Public Value As Double

数据获取函数示例 #

Function DataGrabberFromSheet(ByRef CurrentDict As Dictionary) As String
    Dim i As Long
    Dim data As Variant
    Dim DataObj As clsData

    Set CurrentDict = New Dictionary ' <--- 这里会重建字典并清理旧数据，但我现在不需要这个逻辑了

    data = Sheet1.Range("A1:Q5000").Values

    For i = 1 To 5000
        Set DataObj = New clsData
        DataObj.Name = data(i, 1)
        DataObj.Prop1 = data(i, 2)
        ' ... 其他属性赋值
        Call CurrentDict.Add(DataObj.Name, DataObj)
    Next

    ' 日志示例
    If Success Then
        DataGrabberFromSheet = "Success"
    Else
        DataGrabberFromSheet = "Bad"
    End If
End Function

1. 主动清空字典而非重建对象 #

不要直接执行Set CurrentDict = New Dictionary，而是清空现有字典的内容、保留字典对象本身，避免销毁大量clsData对象触发的垃圾回收：

' 替代 Set CurrentDict = New Dictionary 的代码
CurrentDict.RemoveAll ' 清空现有元素，保留字典对象

2. 提前断开对象引用，减轻垃圾回收负担 #

在清空字典前，主动遍历字典并将每个clsData对象的引用置空，减少Excel垃圾回收的工作量：

Sub ClearDictWithCleanup(ByRef targetDict As Dictionary)
    Dim key As Variant
    Dim tempObj As clsData

    For Each key In targetDict.Keys
        Set tempObj = targetDict(key)
        ' 清空对象所有属性，进一步断开引用链
        tempObj.Name = vbNullString
        tempObj.Prop1 = vbNullString
        ' ... 其他属性依次置空
        Set tempObj = Nothing ' 断开对象引用
    Next key

    targetDict.RemoveAll ' 清空字典
End Sub

调用时直接替换重建字典的代码为Call ClearDictWithCleanup(CurrentDict)。

3. 全局字典批量重置 #

针对State模块中的公共字典，创建批量重置子程序，在宏启动时统一处理所有字典：

' 在State模块中添加
Sub ResetAllStateDictionaries()
    ClearDictWithCleanup Dict1
    ClearDictWithCleanup Dict2
    ClearDictWithCleanup Dict3
    ' ... 依次处理所有公共字典
End Sub

4. 用对象池复用clsData对象 #

如果需要频繁创建大量clsData，维护一个对象池避免重复创建/销毁对象：

' 在State模块中添加公共对象池字典
Public DataObjPool As Dictionary

' 初始化对象池
Sub InitDataObjPool()
    Set DataObjPool = New Dictionary
End Sub

' 获取复用的clsData对象
Function GetDataObj() As clsData
    Dim tempObj As clsData
    If DataObjPool.Count > 0 Then
        ' 从池中取出对象并重置属性
        Set tempObj = DataObjPool.Items(0)
        DataObjPool.Remove DataObjPool.Keys(0)
        ' 重置属性
        tempObj.Name = vbNullString
        tempObj.Prop1 = vbNullString
        ' ... 其他属性置空
    Else
        ' 池中无对象时新建
        Set tempObj = New clsData
    End If
    Set GetDataObj = tempObj
End Function

' 回收对象到池
Sub RecycleDataObj(ByRef obj As clsData)
    DataObjPool.Add DataObjPool.Count + 1, obj
    Set obj = Nothing
End Sub

数据填充时用Set DataObj = GetDataObj()替代Set DataObj = New clsData，不再需要的对象用Call RecycleDataObj(DataObj)回收。

5. 强制触发垃圾回收（慎用） #

在重置字典后，手动触发Excel的垃圾回收，减少后续冻结概率：

Sub ForceGC()
    Dim i As Integer
    ' 多次调用DoEvents和全量计算触发资源整理
    For i = 1 To 3
        DoEvents
        Application.CalculateFullRebuild
    Next i
    Dim tempObj As clsData
    Set tempObj = Nothing ' 辅助触发GC
End Sub

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