Office 16环境下VBA宏工作机报错1004及代码精简求助

1. 排序报错（Run-time error '1004'）修复 #

报错核心原因：

• 未确保AutoFilter已启用就调用其Sort对象
• Add2方法在部分Office版本存在兼容性问题
• Key引用的Range未指定所属工作表，可能指向错误的激活表

修复措施：

• 先检查并启用AutoFilter（和筛选逻辑统一）
• 用兼容性更好的Add替代Add2
• 明确指定Key的所属工作表
• 增加错误处理避免意外情况

2. 自动筛选逻辑修正 #

原代码会切换筛选状态，改为仅在无筛选时添加：

• 移除Range中的无效空格（A1: Y1→A1:Y1）
• 绑定具体工作表对象，避免引用歧义
• 基于AutoFilterMode判断，仅当无筛选时启用

3. 条件格式代码精简 #

宏录制的代码大量依赖Select和Selection，低效且易出错，优化方向：

• 直接操作Range对象，取消所有Select操作
• 将重复的条件格式逻辑封装为子过程，减少冗余代码
• 对同一列的多值条件用循环批量处理

优化后的完整代码 #

Sub OptimizedTest()
    Dim ws As Worksheet
    Set ws = ActiveWorkbook.Worksheets("Sheet1") ' 明确绑定工作表，避免歧义
    
    ' 第一行格式设置
    With ws.Range("A1:Y1").Font
        .Bold = True
        .Underline = True
        .Size = 12
    End With
    
    ' 设置全局字体为Times New Roman
    ws.Cells.Font.Name = "Times New Roman"
    
    ' 仅在无筛选时添加自动筛选
    If Not ws.AutoFilterMode Then
        ws.Range("A1:Y1").AutoFilter
    End If
    
    ' 自动适配列宽和行高
    ws.Cells.Columns.AutoFit
    ws.Cells.Rows.AutoFit
    
    ' 批量添加条件格式
    ' 列M的两个值条件（整行高亮）
    AddRowCF ws.Range("A:Y"), "$M1=""XXXX""", xlThemeColorAccent6, 0.599963377788629
    AddRowCF ws.Range("A:Y"), "$M1=""XXXX2""", xlThemeColorAccent2, 0.399945066682944
    
    ' 列K的四个值条件（整行高亮）
    Dim kValues As Variant
    kValues = Array("XXXX", "XXXX2", "XXXX3", "XXXX4")
    Dim val As Variant
    For Each val In kValues
        AddRowCF ws.Range("A:Y"), "$K1=""" & val & """", xlThemeColorAccent2, 0.399945066682943
    Next val
    
    ' 列R：值在1-200之间（单元格格式）
    With ws.Range("R:R").FormatConditions.Add(Type:=xlCellValue, Operator:=xlBetween, Formula1:="=1", Formula2:="=200")
        .SetFirstPriority
        With .Font
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = 0
        End With
        With .Interior
            .PatternColorIndex = xlAutomatic
            .Color = 192
            .TintAndShade = 0
        End With
        .StopIfTrue = False
    End With
    
    ' 列R：包含"EXP"文本（单元格格式）
    With ws.Range("R:R").FormatConditions.Add(Type:=xlTextString, String:="EXP", TextOperator:=xlContains)
        .SetFirstPriority
        With .Font
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = 0
        End With
        With .Interior
            .PatternColorIndex = xlAutomatic
            .Color = 192
            .TintAndShade = 0
        End With
        .StopIfTrue = False
    End With
    
    ' 列H：前15个最大值（加粗+高亮）
    With ws.Range("H:H").FormatConditions.AddTop10
        .SetFirstPriority
        .TopBottom = xlTop10Top
        .Rank = 15
        With .Font
            .Bold = True
            .Italic = False
            .TintAndShade = 0
        End With
        With .Interior
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent1
            .TintAndShade = 0.399945066682943
        End With
        .StopIfTrue = False
    End With
    
    ' 排序：按H列降序
    On Error Resume Next ' 防止排序对象不存在的情况
    ws.AutoFilter.Sort.SortFields.Clear
    On Error GoTo 0
    
    ws.AutoFilter.Sort.SortFields.Add _
        Key:=ws.Range("H:H"), _
        SortOn:=xlSortOnValues, _
        Order:=xlDescending, _
        DataOption:=xlSortNormal
    
    With ws.AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

' 封装整行条件格式的子过程，减少重复代码
Sub AddRowCF(targetRange As Range, formula As String, themeColor As XlThemeColor, tint As Double)
    With targetRange.FormatConditions.Add(Type:=xlExpression, Formula1:=formula)
        .SetFirstPriority
        With .Interior
            .PatternColorIndex = xlAutomatic
            .ThemeColor = themeColor
            .TintAndShade = tint
        End With
        .StopIfTrue = False
    End With
End Sub

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