Excel工作簿重启报错：内容异常需恢复，VBA代码及格式丢失

问题现象 #

• 工作簿运行期间功能正常，关闭后重新打开弹出报错：“我们在‘工作簿名称’中发现部分内容存在问题，是否尝试尽可能恢复？”
• 选择恢复后，仅负责触发变更或工作表激活的代码会被移至新工作表，原工作表所有格式被清空
• 曾通过隔离部分代码暂时解决问题，但错误后续扩散到与之前问题工作表无共用子过程的其他工作表

核心问题排查方向 #

1. 数据验证列表字符数超限 #

Excel数据验证下拉列表（xlValidateList）对Formula1参数有隐性字符限制（旧版本上限255字符，365版本虽放宽但仍存在阈值）。你的代码通过拼接数据库查询结果生成Icode，当结果过多时会导致字符串超长，写入数据验证时破坏工作表结构。

2. 数据库资源未正确释放 #

代码中调用establish_conn和open_conn初始化连接，但未完整释放资源：

• 记录集rs仅执行了Close，未设置Set rs = Nothing释放对象
• 全局连接conn未在过程结束后关闭并释放，残留的COM对象可能导致文件保存时损坏

3. 工作表事件代码无错误捕获 #

被移位的均为工作表级事件代码（如Worksheet_Change、Worksheet_Activate），这类代码若未添加错误捕获逻辑，执行异常时会在文件保存时写入无效数据，触发后续的损坏提示。

4. 循环中频繁修改数据验证 #

循环内反复执行Validation.Delete和Validation.Add操作，可能导致Excel底层XML结构（xlsx本质为压缩XML文件）出现异常，最终引发文件损坏。

针对示例代码的修复建议 #

优化数据验证列表生成逻辑 #

当查询结果较多时，改用动态命名区域替代字符串拼接，避开字符数限制：

' 替换原数据验证添加代码段
If Len(Icode) > 0 Then
    Icode = Left(Icode, Len(Icode) - 1)
    ' 将拆分后的列表写入临时列（示例用X列）
    ws.Range("X" & i).Resize(UBound(Split(Icode, ",")) + 1, 1).Value = Application.Transpose(Split(Icode, ","))
    ' 创建动态命名区域
    ThisWorkbook.Names.Add _
        Name:="ModelList_" & i, _
        RefersToR1C1:="=Indoor!R" & i & "C24:INDEX(Indoor!R" & i & "C24,COUNTA(Indoor!R" & i & "C24))"
    ' 数据验证引用命名区域
    With rngcode.Validation
        .Delete
        .Add Type:=xlValidateList, Formula1:="=ModelList_" & i
    End With
Else
    With rngcode.Validation
        .Delete
    End With
End If

完善数据库资源释放 #

在ValidateIdCode过程末尾添加资源释放代码：

' 过程末尾补充
If Not rs Is Nothing Then
    If rs.State = 1 Then rs.Close
    Set rs = Nothing
End If
If Not conn Is Nothing Then
    If conn.State = 1 Then conn.Close
    Set conn = Nothing
End If

批量处理数据验证操作 #

避免循环内频繁修改验证规则，先批量收集所有需要设置的验证信息，再一次性写入：

' 替换原循环逻辑，先收集验证数据
Dim validateDict As Object
Set validateDict = CreateObject("Scripting.Dictionary")

For i = 8 To lr
    If ws.Cells(i, 1).Value <> "" Then
        ' ... 原数据库查询逻辑 ...
        If Len(Icode) > 0 Then
            validateDict.Add ws.Range("C" & i).Address, Left(Icode, Len(Icode)-1)
        End If
    End If
Next

' 批量设置数据验证
Dim key As Variant
For Each key In validateDict.Keys
    With ws.Range(key).Validation
        .Delete
        .Add Type:=xlValidateList, Formula1:=validateDict(key)
    End With
Next

给工作表事件代码添加错误捕获 #

对所有工作表级事件代码添加错误处理：

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo ErrorHandler
    ' 原事件代码逻辑
    Exit Sub
ErrorHandler:
    Err.Clear
    ' 可根据需求添加错误提示或日志
End Sub

通用修复步骤 #

1. 新建空白.xlsm工作簿，将原工作簿的工作表内容（仅复制单元格内容，不包含代码）迁移至新工作簿
2. 重新编写模块级和工作表级代码，避免直接复制原代码模块（防止残留损坏结构）
3. 保存后，开启Excel选项→信任中心→信任中心设置→宏设置→禁用所有宏并发出通知，再关闭重开测试
4. 使用文件→信息→检查问题→检查文件扫描并修复潜在损坏内容

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