请求优化Excel宏：实现动态表格的两级自定义排序

需求说明 #

• 对每日更新、行数动态变化的表格执行两级排序：
  1. 第一级：按C列（从C2单元格开始）的单元格值**升序（xlAscending，从旧到新）**排序
  2. 第二级：按D列（从D2单元格开始）的单元格值，使用自定义列表排序，列表内容为：Greater London, Liverpool, Birmingham, Manchester, Sheffield, Leeds, Bristol（实际使用的列表更长）

你的原始代码 #

Sub CustomSort()

Range("B2").CurrentRegion.Sort _ 
key1:= Range("C2"), Order1:=xlAscending, Orientation:=xlTopToBottom, Header:=xlYes, _
key2:= Range("D2"), Order1:=xlAscending, Orientation:=xlTopToBottom, Header:=xlYes, CustomOrder:= _
"Greater London,Liverpool,Birmingham,Manchester,Sheffield,Leeds,Bristol"

End Sub

优化与修正建议 #

1. 修复语法错误

代码里有两处明显语法问题：

• 第二级排序的顺序参数写错了，应该是Order2而非重复的Order1
• Orientation和Header参数无需重复声明，整个Sort方法只需要写一次

2. 提升动态范围的可靠性

虽然CurrentRegion能自动识别连续数据区域，但建议先把目标区域赋值给变量，既提升代码可读性，也避免因当前单元格位置变化导致的错误：

Dim ws As Worksheet
Dim sortRange As Range
Set ws = ActiveSheet ' 建议改成具体工作表名，比如ThisWorkbook.Worksheets("数据")
Set sortRange = ws.Range("B2").CurrentRegion

3. 优化自定义列表的维护性

如果自定义列表很长，直接写在代码里会难以修改。可以把列表存到工作表的隐藏单元格区域（比如A1:A100），或者定义成常量数组：

' 方式1：从工作表隐藏区域读取列表
Dim customList As String
customList = Join(ws.Range("A1:A7").Value, ",") ' 假设列表存在A1到A7

' 方式2：定义常量数组（适合不常修改的列表）
Const CUSTOM_SORT_LIST As String = "Greater London,Liverpool,Birmingham,Manchester,Sheffield,Leeds,Bristol"

4. 添加基础错误处理与性能优化

• 排序前关闭屏幕更新，减少卡顿；执行完成后恢复
• 添加错误捕获，避免因数据异常导致宏崩溃

优化后的完整代码示例 #

Sub OptimizedCustomSort()
    Dim ws As Worksheet
    Dim sortRange As Range
    Const CUSTOM_SORT_LIST As String = "Greater London,Liverpool,Birmingham,Manchester,Sheffield,Leeds,Bristol"
    
    ' 指定目标工作表，避免依赖激活的工作表
    Set ws = ThisWorkbook.Worksheets("数据") ' 替换成你的工作表名称
    Set sortRange = ws.Range("B2").CurrentRegion
    
    ' 关闭屏幕更新提升性能
    Application.ScreenUpdating = False
    
    On Error GoTo Cleanup ' 错误捕获
    
    ' 执行两级排序
    sortRange.Sort _
        Key1:=ws.Range("C2"), Order1:=xlAscending, _
        Key2:=ws.Range("D2"), Order2:=xlAscending, _
        CustomOrder:=CUSTOM_SORT_LIST, _
        Orientation:=xlTopToBottom, Header:=xlYes
        
Cleanup:
    ' 恢复屏幕更新
    Application.ScreenUpdating = True
    If Err.Number <> 0 Then
        MsgBox "排序出错：" & Err.Description, vbExclamation
    End If
End Sub

额外建议 #

如果你的数据是Excel结构化表格（插入的表格对象），可以直接用表格的Sort方法，稳定性更强：

Sub TableCustomSort()
    Dim tbl As ListObject
    Const CUSTOM_SORT_LIST As String = "Greater London,Liverpool,Birmingham,Manchester,Sheffield,Leeds,Bristol"
    
    Set tbl = ThisWorkbook.Worksheets("数据").ListObjects("Table1") ' 替换成你的表格名称
    
    With tbl.Sort
        .SortFields.Clear
        .SortFields.Add Key:=tbl.ListColumns("日期").Range, SortOn:=xlSortOnValues, Order:=xlAscending
        .SortFields.Add Key:=tbl.ListColumns("城市").Range, SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:=CUSTOM_SORT_LIST
        .Header = xlYes
        .Apply
    End With
End Sub

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