Worksheet_Change循环不足300行致Excel崩溃问题求助

问题根源 #

1. 事件递归循环：修改Sheet1触发其Change事件，修改Sheet2后又触发Sheet2的Change事件，反过来再修改Sheet1，无限循环直接导致Excel崩溃。
2. 边界情况未处理：如果修改的是第1列单元格，Offset(0,-1)会引用无效区域；如果选中多个单元格修改，Target是多单元格区域，代码会直接报错。
3. 遍历效率低下：大工作簿里逐行循环对比单元格值，频繁读写单元格拖慢性能，触发报错。

修复后的代码 #

Sheet1 代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 只处理单个单元格，且是第7列（要同步的列，前一列是匹配键）
    If Target.Cells.Count > 1 Or Target.Column <> 7 Then Exit Sub
    
    Dim matchRow As Variant
    Dim keyValue As Variant
    
    keyValue = Target.Offset(0, -1).Value
    If IsEmpty(keyValue) Then Exit Sub ' 前一列是空值就不处理
    
    Application.EnableEvents = False ' 关闭事件，避免递归
    On Error GoTo Cleanup ' 出错时强制恢复事件状态
    
    ' 用Match函数快速查找Sheet2第6列匹配的行
    matchRow = Application.Match(keyValue, Worksheets("Sheet2").Range("F10:F290"), 0)
    If Not IsError(matchRow) Then
        Worksheets("Sheet2").Cells(matchRow + 9, 7).Value = Target.Value ' F10对应索引1，所以加9
    End If

Cleanup:
    Application.EnableEvents = True ' 无论是否出错，都恢复事件触发
End Sub

Sheet2 代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 只处理单个单元格，且是第7列
    If Target.Cells.Count > 1 Or Target.Column <> 7 Then Exit Sub
    
    Dim matchRow As Variant
    Dim keyValue As Variant
    
    keyValue = Target.Offset(0, -1).Value
    If IsEmpty(keyValue) Then Exit Sub
    
    Application.EnableEvents = False
    On Error GoTo Cleanup
    
    ' 查找Sheet1第6列匹配的行
    matchRow = Application.Match(keyValue, Worksheets("Sheet1").Range("F19:F66"), 0)
    If Not IsError(matchRow) Then
        Worksheets("Sheet1").Cells(matchRow + 18, 7).Value = Target.Value ' F19对应索引1，加18
    End If

Cleanup:
    Application.EnableEvents = True
End Sub

代码说明 #

• 关闭事件触发：Application.EnableEvents = False 彻底打破递归循环，避免修改另一个工作表时再次触发Change事件。
• 边界检查：先确认Target是单个目标列单元格，前一列空值直接退出，避免无效操作和错误。
• 高效查找：用Application.Match替代逐行循环，查找速度更快，减少单元格读写次数，大幅提升大工作簿的运行稳定性。
• 错误兜底：On Error GoTo Cleanup确保即使代码出错，也能恢复事件触发状态，不会导致后续Excel事件失效。

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