好像少了Apply，可以添加吗

MyWorksheet.Sort.Apply

你的定制订单和我的样品一样。

编辑根据OP更新的问题进行更新

将宏编辑为以下内容-使用OrderCustom参数的数组。

Dim oWorksheet As Worksheet
Set oWorksheet = ActiveWorkbook.Worksheets("Sheet1")
Dim oRangeSort As Range
Dim oRangeKey As Range

' one range that includes all colums do sort
Set oRangeSort = oWorksheet.Range("A1:B9")
' start of column with keys to sort
Set oRangeKey = oWorksheet.Range("B1")

' custom sort order
Dim sCustomList(1 To 3) As String
sCustomList(1) = "Cyberspace"
sCustomList(2) = "Aerospace"
sCustomList(3) = "Air, Land, or Sea"

Application.AddCustomList ListArray:=sCustomList
' use this if you want a list on the spreadsheet to sort by
' Application.AddCustomList ListArray:=Range("D1:D3")

oWorksheet.Sort.SortFields.Clear
oRangeSort.Sort Key1:=oRangeKey, Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=Application.CustomListCount + 1, MatchCase:=False, _
    Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

' clean up
Application.DeleteCustomList Application.CustomListCount
Set oWorksheet = Nothing

好的……根据更新的描述，为您正在排序的列旁边的列提供一个公式如何？
因此，如果“Air，Land，or Sea”在B1列中，则C1将有：

=SUBSTITUTE(B1,",","|")

然后你可以像这样做你的自定义排序：

MyWorksheet.Sort.SortFields.Add Key:=Range( _

        "B:B"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        CustomOrder:= "Cyberspace,Air|Land|or Sea,Aerospace", _
        DataOption:=xlSortNormal  
    MyWorksheet.Sort.Apply

确保适当调整范围。

使用额外的引号也应该可以

CustomOrder:="""Cyberspace,Air"",""Land"",""or Sea,Aerospace"""