Excel VBA连续两次自定义排序触发Run-time error 1004报错求助

在多工作表工作簿中连续执行两次自定义排序时，第二次总会抛出**“Run-time error ‘1004’: The sort reference is not valid”**错误。两次排序分别针对不同工作表，两张目标表均包含“Project Terr.”和“SpecTRAK ID”表头，通过FindColumnName函数定位表头列。调换工作表排序顺序后，始终第一次排序成功、第二次失败。

报错代码片段 #

Sub TerritorySort(mysheet As Worksheet, rng As Range)
Dim vCustom_Sort As Variant
Dim n As Long
Dim rKey1 As Range, rKey2 As Range, rKey3 As Range
Dim Created As Boolean

 Created = False
 vCustom_Sort = Array("A01", "A02", "A03", "A999 N/A", "A07", "A31", "A08", "A13", "A15", "A16", _
                       "A21", "A32", "A22", "A27", "A28", "A37", "A39", "A38", "A43", "A44", Chr(42))
 n = Application.GetCustomListNum(vCustom_Sort)
 If n = 0 Then
   Application.AddCustomList ListArray:=vCustom_Sort
   Created = True
 End If
 n = Application.CustomListCount + 1
 
 Set rKey1 = FindColumnName(mysheet, "Project Terr.", 1, 0)
 Set rKey2 = FindColumnName(mysheet, "SpecTRAK ID", 1, 0)
 rng.Sort Key1:=rKey1, Order1:=xlAscending, OrderCustom:=n, _
            Key2:=rKey2, Order2:=xlAscending, Header:=xlYes
End Sub

测试用例 #

Sub TestSort()
  Dim wbAct As Workbook: Set wbAct = ActiveWorkbook
  Dim wsAct As Worksheet
  Dim DataRange As Range

  Set wsAct = wbAct.Sheets("New") 'use sheet New as active sheet
  Set DataRange = FindDataRange(wsAct)
  Call TerritorySort(wsAct, DataRange)
  wsAct.Sort.SortFields.Clear
  
  Set wsAct = wbAct.Sheets("PS-PBNQ") 'use sheet PS-PBNQ as active sheet
  Set DataRange = FindDataRange(wsAct)
  Call TerritorySort(wsAct, DataRange)
End Sub

问题原因 #

1. 自定义列表索引计算错误：代码中n = Application.CustomListCount + 1是核心问题。GetCustomListNum已经能返回自定义列表的正确编号，但后续强行将n设为列表总数+1，超出了实际存在的自定义列表索引范围。第一次排序可能因Excel缓存未触发验证，但切换工作表后，Excel严格校验索引有效性，直接抛出错误。
2. 排序对象残留设置未清理：虽然测试用例中清理了SortFields，但Sort对象的其他属性（如之前的自定义列表索引）可能残留，切换工作表后引发冲突。
3. 自定义列表重复处理隐患：第一次运行添加自定义列表后，第二次运行GetCustomListNum能找到已存在的列表，但错误的索引计算逻辑依然会生成无效编号。

解决方法 #

1. 修正自定义列表索引逻辑 #

直接使用GetCustomListNum返回的正确编号，删除错误的n = Application.CustomListCount + 1语句。如果是新创建的列表，添加后重新调用GetCustomListNum获取编号。

2. 每次排序前后清理Sort对象 #

在排序前后清理当前工作表的Sort字段，避免残留设置影响后续操作。

3. 可选：临时自定义列表用完即删 #

如果该自定义列表仅用于本次排序，运行结束后可删除，避免污染Excel的自定义列表库。

修改后的代码示例 #

修正后的TerritorySort #

Sub TerritorySort(mysheet As Worksheet, rng As Range)
    Dim vCustom_Sort As Variant
    Dim n As Long
    Dim rKey1 As Range, rKey2 As Range
    Dim Created As Boolean

    Created = False
    vCustom_Sort = Array("A01", "A02", "A03", "A999 N/A", "A07", "A31", "A08", "A13", "A15", "A16", _
                         "A21", "A32", "A22", "A27", "A28", "A37", "A39", "A38", "A43", "A44", Chr(42))
    n = Application.GetCustomListNum(vCustom_Sort)
    If n = 0 Then
        Application.AddCustomList ListArray:=vCustom_Sort
        Created = True
        n = Application.GetCustomListNum(vCustom_Sort) ' 添加后重新获取正确编号
    End If
    
    Set rKey1 = FindColumnName(mysheet, "Project Terr.", 1, 0)
    Set rKey2 = FindColumnName(mysheet, "SpecTRAK ID", 1, 0)
    
    ' 排序前清理当前工作表的Sort设置
    mysheet.Sort.SortFields.Clear
    rng.Sort Key1:=rKey1, Order1:=xlAscending, OrderCustom:=n, _
             Key2:=rKey2, Order2:=xlAscending, Header:=xlYes
    ' 排序后再次清理，避免残留
    mysheet.Sort.SortFields.Clear
End Sub

修正后的TestSort #

Sub TestSort()
    Dim wbAct As Workbook: Set wbAct = ActiveWorkbook
    Dim wsAct As Worksheet
    Dim DataRange As Range
    Dim customListNum As Long
    Dim vCustom_Sort As Variant

    ' 提前获取自定义列表编号，避免重复计算
    vCustom_Sort = Array("A01", "A02", "A03", "A999 N/A", "A07", "A31", "A08", "A13", "A15", "A16", _
                         "A21", "A32", "A22", "A27", "A28", "A37", "A39", "A38", "A43", "A44", Chr(42))
    customListNum = Application.GetCustomListNum(vCustom_Sort)
    If customListNum = 0 Then
        Application.AddCustomList ListArray:=vCustom_Sort
        customListNum = Application.GetCustomListNum(vCustom_Sort)
    End If

    Set wsAct = wbAct.Sheets("New")
    Set DataRange = FindDataRange(wsAct)
    Call TerritorySort(wsAct, DataRange)

    Set wsAct = wbAct.Sheets("PS-PBNQ")
    Set DataRange = FindDataRange(wsAct)
    Call TerritorySort(wsAct, DataRange)

    ' 可选：如果不需要保留自定义列表，运行结束后删除
    ' Application.DeleteCustomList customListNum
End Sub

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