Excel VBA自定义排序与筛选问题求助：多列自定义排序报错

问题回顾 #

需要实现两个操作：

• 筛选数据区域的第2列（Field:=2），保留值为1的行，排除0
• 按**Priority列（E列）**的自定义顺序「HOT,Follow-Up」、**Status列（I列）**的自定义顺序「Complete,On-Going,NEW」排序
  当前筛选功能正常，但自定义排序时触发「Object expected」或「Object variable or with block variable not set」错误，数据为普通单元格区域（非ListObject表格）

错误原因分析 #

常见触发错误的原因：

• 未明确指定排序的目标数据区域，导致Sort对象无法绑定有效范围
• 自定义排序顺序未正确添加到Excel的自定义列表（部分版本要求必须先注册自定义列表才能使用）
• SortFields的Key设置错误，指向了不存在的单元格或区域

完整解决代码 #

Sub FilterAndCustomSort()
    Dim ws As Worksheet
    Dim dataRange As Range
    Dim lastRow As Long, lastCol As Long
    
    ' 替换为你的目标工作表名称
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    ' 清除现有筛选状态
    If ws.AutoFilterMode Then ws.AutoFilterMode = False
    
    ' 定位完整数据区域（假设表头在第1行）
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    Set dataRange = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, lastCol))
    
    ' 执行筛选：第2列（Field:=2，对应B列，从筛选区域首列开始计数）保留值为1的行
    dataRange.AutoFilter Field:=2, Criteria1:="1"
    
    ' 检查筛选后是否有可见数据
    Dim visibleRange As Range
    On Error Resume Next
    Set visibleRange = dataRange.Offset(1).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    If Not visibleRange Is Nothing Then
        ' 定义自定义排序规则
        Dim priorityOrder As Variant, statusOrder As Variant
        priorityOrder = Array("HOT", "Follow-Up")
        statusOrder = Array("Complete", "On-Going", "NEW")
        
        ' 注册自定义列表（避免重复添加）
        Dim listExists As Boolean, i As Integer
        listExists = False
        For i = 1 To Application.CustomListCount
            If Join(Application.GetCustomListContents(i), ",") = Join(priorityOrder, ",") Then
                listExists = True
                Exit For
            End If
        Next i
        If Not listExists Then Application.AddCustomList priorityOrder
        
        listExists = False
        For i = 1 To Application.CustomListCount
            If Join(Application.GetCustomListContents(i), ",") = Join(statusOrder, ",") Then
                listExists = True
                Exit For
            End If
        Next i
        If Not listExists Then Application.AddCustomList statusOrder
        
        ' 执行自定义排序
        With ws.Sort
            .SortFields.Clear
            ' 添加Priority列排序规则（E列）
            .SortFields.Add Key:=ws.Range("E1"), _
                            SortOn:=xlSortOnValues, _
                            Order:=xlAscending, _
                            CustomOrder:=Join(priorityOrder, ",")
            ' 添加Status列排序规则（I列）
            .SortFields.Add Key:=ws.Range("I1"), _
                            SortOn:=xlSortOnValues, _
                            Order:=xlAscending, _
                            CustomOrder:=Join(statusOrder, ",")
            ' 指定排序范围为完整数据区域
            .SetRange dataRange
            .Header = xlYes ' 第一行是表头
            .MatchCase = False
            .Orientation = xlTopToBottom
            .Apply
        End With
    Else
        MsgBox "无符合筛选条件的数据"
    End If
    
    ' 可选：取消筛选以查看完整排序结果
    ' ws.AutoFilterMode = False
End Sub

关键注意事项 #

1. 数据区域定位：必须明确dataRange的范围，确保包含表头和所有数据行，这是避免对象未设置错误的核心
2. 自定义列表注册：部分Excel版本不支持直接在CustomOrder中传入字符串数组，因此需要先将排序规则添加到Excel的自定义列表
3. Sort对象配置：必须通过.SetRange指定排序范围，同时设置.Header = xlYes确保表头不参与排序
4. 错误处理：筛选后检查visibleRange是否存在，避免无数据时执行排序触发错误

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