选中区域Trim操作过慢，如何提升处理速度？

原代码逐个循环单元格调用工作表函数，频繁的单元格读写与函数交互是导致速度慢的核心原因，以下是几种高效优化方案：

方案1：关闭Excel非必要功能+循环优化 #

通过关闭屏幕刷新、事件触发和自动计算，减少Excel后台额外操作，即使保留循环也能大幅提速：

Sub Trim_Selection_Fast1()
    Dim A As Range
    Dim cell As Range
    ' 保存原状态
    Dim origScreenUpdating As Boolean
    Dim origEnableEvents As Boolean
    Dim origCalculation As XlCalculation
    
    origScreenUpdating = Application.ScreenUpdating
    origEnableEvents = Application.EnableEvents
    origCalculation = Application.Calculation
    
    ' 关闭非必要功能
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    Set A = Selection
    For Each cell In A
        If Not IsEmpty(cell.Value) Then ' 跳过空单元格
            cell.Value = WorksheetFunction.Trim(cell.Value)
        End If
    Next cell
    
    ' 恢复原状态
    Application.ScreenUpdating = origScreenUpdating
    Application.EnableEvents = origEnableEvents
    Application.Calculation = origCalculation
End Sub

方案2：数组批量处理（推荐） #

将选中区域数据一次性读入内存数组，在内存中完成Trim操作后再批量写回单元格，彻底避免频繁的单元格读写交互，速度提升最明显：

Sub Trim_Selection_Fast2()
    Dim A As Range
    Dim dataArr As Variant
    Dim i As Long, j As Long
    
    ' 保存原状态并关闭非必要功能
    Dim origScreenUpdating As Boolean
    Dim origEnableEvents As Boolean
    Dim origCalculation As XlCalculation
    
    origScreenUpdating = Application.ScreenUpdating
    origEnableEvents = Application.EnableEvents
    origCalculation = Application.Calculation
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    Set A = Selection
    If A.Cells.Count = 1 Then
        ' 处理单个单元格的情况
        A.Value = WorksheetFunction.Trim(A.Value)
    Else
        ' 数据读入数组
        dataArr = A.Value
        ' 遍历数组处理
        For i = LBound(dataArr, 1) To UBound(dataArr, 1)
            For j = LBound(dataArr, 2) To UBound(dataArr, 2)
                If Not IsEmpty(dataArr(i, j)) Then
                    dataArr(i, j) = WorksheetFunction.Trim(dataArr(i, j))
                End If
            Next j
        Next i
        ' 批量写回单元格
        A.Value = dataArr
    End If
    
    ' 恢复原状态
    Application.ScreenUpdating = origScreenUpdating
    Application.EnableEvents = origEnableEvents
    Application.Calculation = origCalculation
End Sub

方案3：正则表达式批量替换 #

针对文本密集、多空格重复的场景，正则表达式可一次性完成首尾空格去除+中间多空格合并：

Sub Trim_Selection_Fast3()
    Dim A As Range
    Dim regExp As Object
    
    ' 保存原状态并关闭非必要功能
    Dim origScreenUpdating As Boolean
    Dim origEnableEvents As Boolean
    Dim origCalculation As XlCalculation
    
    origScreenUpdating = Application.ScreenUpdating
    origEnableEvents = Application.EnableEvents
    origCalculation = Application.Calculation
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    Set regExp = CreateObject("VBScript.RegExp")
    regExp.Global = True
    ' 匹配首尾空格和中间连续空格
    regExp.Pattern = "^ +| +$|( )+"
    Set A = Selection
    
    For Each cell In A
        If Not IsEmpty(cell.Value) And TypeName(cell.Value) = "String" Then
            cell.Value = regExp.Replace(cell.Value, "$1")
        End If
    Next cell
    
    ' 恢复原状态
    Application.ScreenUpdating = origScreenUpdating
    Application.EnableEvents = origEnableEvents
    Application.Calculation = origCalculation
    Set regExp = Nothing
End Sub

注意事项 #

• 方案2的数组处理是速度最快的，尤其适合几千上万单元格的大区域；
• 所有方案均保留原代码WorksheetFunction.Trim的功能（去除首尾空格+合并中间多空格），若仅需去除首尾空格，可替换为VBA内置Trim()函数，速度会进一步提升；
• 操作完成后必须恢复Excel原状态，避免影响后续使用。

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