VBA列宽调整子程序致Excel撤销异常及滚动卡顿问题求助

• 撤销功能失效：Excel的撤销栈会被VBA对工作表的修改操作清空，你的代码每次选中单元格都会执行列宽修改，频繁覆盖撤销栈，导致无法正常撤销手动操作。
• 滚动卡顿：Worksheet_SelectionChange事件会在每次选中单元格（包括滚动时选中区域变化）时触发，遍历所有列执行AutoFit或设置列宽是高开销操作，频繁执行会耗尽Excel资源，造成滚动变慢。

1. 更换触发事件 #

把Worksheet_SelectionChange换成Worksheet_Change，仅在单元格内容实际修改时调整列宽，避免无意义的重复执行。

2. 避免重复调整 #

添加判断逻辑，仅当列宽不符合要求时才执行操作：

• 非J列：仅当当前列宽与AutoFit后的宽度差异超过阈值（比如1）时更新，避免微小变动重复操作。
• J列：仅当当前列宽不等于80时才设置，避免重复赋值。

3. 提升性能 #

• 执行过程中关闭屏幕更新和事件触发，避免Excel频繁刷新界面。
• 优先调整修改单元格所在的列，而非全局所有列（如果需要全局适配，可保留全局逻辑但加缓存判断）。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet
    Dim targetCol As Long
    Dim autoFitWidth As Double
    Const J_COLUMN As Long = 10
    Const J_WIDTH As Double = 80
    Const WIDTH_THRESHOLD As Double = 1 ' 列宽差异超过此值才更新

    Set ws = Me
    
    ' 关闭屏幕更新和事件触发，减少资源消耗
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    On Error GoTo Cleanup ' 确保出错时恢复设置
    
    ' 仅调整修改单元格所在的列（高效模式）
    For Each targetCol In Target.Columns
        If targetCol <> J_COLUMN Then
            ws.Columns(targetCol).AutoFit
            autoFitWidth = ws.Columns(targetCol).ColumnWidth
            ' 只有差异超过阈值才保留AutoFit结果
            If Abs(ws.Columns(targetCol).ColumnWidth - autoFitWidth) > WIDTH_THRESHOLD Then
                ws.Columns(targetCol).ColumnWidth = autoFitWidth
            End If
        Else
            ' J列宽度不符才设置
            If ws.Columns(J_COLUMN).ColumnWidth <> J_WIDTH Then
                ws.Columns(J_COLUMN).ColumnWidth = J_WIDTH
            End If
        End If
    Next targetCol
    
    ' --- 若需要全局所有列适配，替换上面的循环为以下代码 ---
    ' Dim maxCol As Long, col As Long
    ' maxCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    ' For col = 1 To maxCol
    '     If col <> J_COLUMN Then
    '         ws.Columns(col).AutoFit
    '         autoFitWidth = ws.Columns(col).ColumnWidth
    '         If Abs(ws.Columns(col).ColumnWidth - autoFitWidth) > WIDTH_THRESHOLD Then
    '             ws.Columns(col).ColumnWidth = autoFitWidth
    '         End If
    '     Else
    '         If ws.Columns(col).ColumnWidth <> J_WIDTH Then
    '             ws.Columns(col).ColumnWidth = J_WIDTH
    '         End If
    '     End If
    ' Next col

Cleanup:
    ' 恢复Excel默认设置
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    If Err.Number <> 0 Then
        MsgBox "错误：" & Err.Description, vbExclamation
    End If
End Sub

• 如果确实需要在选中单元格时调整列宽（比如切换列时适配），可保留Worksheet_SelectionChange事件，但需添加判断：仅当选中的列与上次选中的列不同时才执行，避免重复触发。
• 关于撤销：VBA操作会清空撤销栈，若要完全保留撤销功能，需通过Application.OnUndo实现自定义撤销逻辑，但较为复杂。上述优化通过减少VBA操作频率，基本能恢复正常撤销功能。

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