Excel VBA：保留条件格式效果后移除条件格式的批量处理问题

问题根源 #

直接对整个区域执行myRange.Interior.Color = myRange.DisplayFormat.Interior.Color会把无填充单元格背景设为黑色，是因为无填充单元格的DisplayFormat.Interior.Color返回值为RGB(0,0,0)（系统默认黑色），批量赋值会将该值覆盖到区域内所有单元格，包括原本无填充的单元格。

高效替代方案 #

不需要遍历近百万个单元格，以下两种方法能大幅减少处理量，提升运行速度：

方案1：仅处理带有条件格式的单元格

利用SpecialCells筛选出所有应用了条件格式的单元格，只对这些单元格执行格式复制，避免处理无格式的空白单元格：

Sub ReplaceConditionalFormatting()
    Dim mySheet As Worksheet
    Dim myRange As Range
    Dim cfCells As Range
    Dim cell As Range
    
    Set mySheet = ActiveSheet ' 替换为目标工作表
    Set myRange = mySheet.Range("A1:CJ4000")
    
    ' 开启加速设置
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    ' 捕获所有带条件格式的单元格（忽略无格式单元格）
    On Error Resume Next
    Set cfCells = myRange.SpecialCells(xlCellTypeAllFormatConditions)
    On Error GoTo 0
    
    ' 仅处理筛选出的单元格
    If Not cfCells Is Nothing Then
        For Each cell In cfCells
            cell.Interior.Color = cell.DisplayFormat.Interior.Color
            cell.Font.Color = cell.DisplayFormat.Font.Color
        Next cell
    End If
    
    ' 删除所有条件格式
    myRange.FormatConditions.Delete
    
    ' 恢复Excel默认设置
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
End Sub

方案2：按条件格式规则批量处理

如果你的条件格式是按规则分组设置的，可以直接针对每个规则的应用区域批量复制格式，无需遍历单个单元格：

Sub CopyCFByRule()
    Dim mySheet As Worksheet
    Dim myRange As Range
    Dim cfRule As FormatCondition
    
    Set mySheet = ActiveSheet
    Set myRange = mySheet.Range("A1:CJ4000")
    
    ' 开启加速设置
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    ' 遍历每个条件格式规则，批量复制对应区域的格式
    For Each cfRule In myRange.FormatConditions
        With cfRule
            .AppliesTo.Interior.Color = .DisplayFormat.Interior.Color
            .AppliesTo.Font.Color = .DisplayFormat.Font.Color
        End With
    Next cfRule
    
    ' 删除所有条件格式
    myRange.FormatConditions.Delete
    
    ' 恢复Excel默认设置
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
End Sub

关键加速技巧 #

• 关闭ScreenUpdating：避免Excel实时刷新界面，减少卡顿
• 关闭EnableEvents：防止触发不必要的工作表事件
• 设置Calculation为手动：暂停自动计算，提升运行速度

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