Excel VBA自定义排序宏本地正常，共享文档他人使用失效

核心问题出在代码逻辑的疏漏：你假设工作簿内存储的自定义列表已经被加载到Excel应用的自定义列表中，但实际上宏并没有执行这一步。Application.CustomListCount +1的写法仅在当前Excel实例已存在对应自定义列表时有效——你的电脑可能之前手动添加过或宏曾运行过添加操作，但同事的Excel实例没有这个列表，排序时找不到规则就默认用字母排序。

修改宏代码，先把工作簿内的自定义列表导入到当前Excel应用的自定义列表中，再用该列表的索引执行排序，同时加入重复检查避免冗余。

修改后的完整代码 #

Sub CustomSort()
    Dim ws As Worksheet
    Dim rulesWs As Worksheet
    Dim ruleLastRow As Long
    Dim lastRow As Long
    Dim rng As Range
    Dim r As Range
    Dim customListIndex As Long
    Dim listExists As Boolean
    Dim i As Long
    
    Set ws = ThisWorkbook.Sheets("Submitted to Business")
    Set rulesWs = ThisWorkbook.Sheets("Rules")

    ' 获取数据最后一行
    ruleLastRow = rulesWs.Cells(rulesWs.Rows.Count, "A").End(xlUp).Row
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row

    ' 定义自定义列表的范围
    Set rng = rulesWs.Range("A2:A" & ruleLastRow)
    
    ' 检查自定义列表是否已存在，避免重复添加
    listExists = False
    For i = 1 To Application.CustomListCount
        If Application.GetCustomListContents(i) = rng.Value Then
            customListIndex = i
            listExists = True
            Exit For
        End If
    Next i
    
    ' 如果列表不存在，添加到Excel应用的自定义列表
    If Not listExists Then
        Application.AddCustomList ListArray:=rng.Value
        customListIndex = Application.CustomListCount
    End If

    ' 定义要排序的范围（修正原代码中未定义的Table对象问题）
    Set r = ws.Range("A2", ws.Cells(lastRow, ws.UsedRange.Columns.Count))

    ' 应用自定义排序
    r.Sort Key1:=ws.Range("B1"), Order1:=xlAscending, OrderCustom:=customListIndex, Header:=xlYes
    
    ' 可选：排序后删除临时自定义列表，避免污染用户的Excel设置
    ' Application.DeleteCustomList customListIndex
End Sub

关键修改点说明 #

• 主动加载自定义列表：通过Application.AddCustomList把工作簿内Rules表的列表导入到当前Excel实例，确保同事电脑也能获取到排序规则
• 重复检查机制：遍历现有自定义列表，避免多次运行宏导致列表重复添加，保证索引准确性
• 替换硬编码索引：用实际获取的列表索引替换原代码中Application.CustomListCount +1的写法，确保排序时指向正确规则
• 修正排序范围：原代码中Table.ListColumns.Count未定义，改为ws.UsedRange.Columns.Count避免运行报错

• 确保同事打开共享工作簿时已启用宏，且工作簿处于可编辑状态
• 此代码兼容Excel 2016及以上版本（包括365），不同版本对自定义列表的支持逻辑一致

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