VBA调用AddCustomList触发1004错误，请求排查问题原因

核心错误点 #

• 数组元素拼接错误：代码中2022年最后一个周元素"KW52 2022"后用了& "KW1 2023"，这会把两个字符串合并成一个无效元素"KW52 2022KW1 2023"，导致自定义列表结构异常，同时数组元素总数不符合预期。
• 未禁用事件触发递归：Worksheet_Change事件执行排序时会再次触发自身，造成无限递归，直接引发1004错误。
• 重复添加自定义列表：每次单元格变化都执行Application.AddCustomList，而Excel最多仅支持64个自定义列表，重复添加会快速达到上限触发错误。
• 自定义列表索引错误：ordercustom:=Application.CustomListCount + 1逻辑错误，刚添加的自定义列表索引就是Application.CustomListCount，不需要额外+1。

修正后的代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim vSortList As Variant
    ' 正确拆分每个周标识为独立数组元素
    vSortList = Array("?", _
        "KW1 2022", "KW2 2022", "KW3 2022", "KW4 2022", "KW5 2022", "KW6 2022", "KW7 2022", "KW8 2022", "KW9 2022", "KW10 2022", _
        "KW11 2022", "KW12 2022", "KW13 2022", "KW14 2022", "KW15 2022", "KW16 2022", "KW17 2022", "KW18 2022", "KW19 2022", "KW20 2022", _
        "KW21 2022", "KW22 2022", "KW23 2022", "KW24 2022", "KW25 2022", "KW26 2022", "KW27 2022", "KW28 2022", "KW29 2022", "KW30 2022", _
        "KW31 2022", "KW32 2022", "KW33 2022", "KW34 2022", "KW35 2022", "KW36 2022", "KW37 2022", "KW38 2022", "KW39 2022", "KW40 2022", _
        "KW41 2022", "KW42 2022", "KW43 2022", "KW44 2022", "KW45 2022", "KW46 2022", "KW47 2022", "KW48 2022", "KW49 2022", "KW50 2022", _
        "KW51 2022", "KW52 2022", _
        "KW1 2023", "KW2 2023", "KW3 2023", "KW4 2023", "KW5 2023", "KW6 2023", "KW7 2023", "KW8 2023", "KW9 2023", "KW10 2023", _
        "KW11 2023", "KW12 2023", "KW13 2023", "KW14 2023", "KW15 2023", "KW16 2023", "KW17 2023", "KW18 2023", "KW19 2023", "KW20 2023", _
        "KW21 2023", "KW22 2023", "KW23 2023", "KW24 2023", "KW25 2023", "KW26 2023", "KW27 2023", "KW28 2023", "KW29 2023", "KW30 2023", _
        "KW31 2023", "KW32 2023", "KW33 2023", "KW34 2023", "KW35 2023", "KW36 2023", "KW37 2023", "KW38 2023", "KW39 2023", "KW40 2023", _
        "KW41 2023", "KW42 2023", "KW43 2023", "KW44 2023", "KW45 2023", "KW46 2023", "KW47 2023", "KW48 2023", "KW49 2023", "KW50 2023", _
        "KW51 2023", "KW52 2023")
    
    On Error GoTo Cleanup
    Application.EnableEvents = False ' 禁用事件，防止递归触发
    
    ' 检查自定义列表是否已存在，避免重复添加
    Dim listExists As Boolean
    Dim i As Integer
    For i = 1 To Application.CustomListCount
        If Application.GetCustomListContents(i)(1) = vSortList(1) Then
            listExists = True
            Exit For
        End If
    Next i
    
    If Not listExists Then
        Application.AddCustomList ListArray:=vSortList
    End If
    
    ' 使用严谨的单元格引用，指定正确的自定义列表索引
    ActiveSheet.UsedRange.Sort Key1:=Me.Cells(2, "F"), Header:=xlYes, OrderCustom:=Application.CustomListCount
    
Cleanup:
    Application.EnableEvents = True ' 恢复事件触发
    If Err.Number <> 0 Then
        MsgBox "错误代码：" & Err.Number & vbCrLf & "错误描述：" & Err.Description
    End If
End Sub

额外说明 #

• 数组拆分：每个周标识都是独立的数组元素，不再用&拼接，确保自定义列表的每个条目都符合预期。
• 事件控制：通过Application.EnableEvents = False避免排序操作再次触发Worksheet_Change事件，防止递归。
• 重复检查：遍历已有自定义列表，避免重复添加导致达到数量上限。
• 严谨引用：用Me.Cells(2, "F")代替[F2]，提升代码兼容性和可读性。

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