Excel VBA CustomSort从范围答案

【问题标题】：Excel VBA CustomSort from RangeExcel VBA CustomSort从范围
【发布时间】：2019-07-22 07:29:37
【问题描述】：

Sub RRC()

Dim noOfLists As String
With Sheets("All_list")
Application.CutCopyMode = False
Application.AddCustomList ListArray:=Range("AU2:AU4")
noOfLists = Application.CustomListCount
noOfLists = noOfLists + 1

End With

ActiveWorkbook.Worksheets("All_list").ListObjects("All").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("All_list").ListObjects("All").Sort.SortFields.Add2 _
        Key:=Range("All[RRC]"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        CustomOrder:=CVar(noOfLists), DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("All_list").ListObjects("All").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


Application.DeleteCustomList (noOfLists - 1)


End Sub

任何人都可以帮助弄清楚为什么这不起作用，它运行，但没有排序。范围 AU2:AU4 将是动态的，这意味着那里的排序总是不同的，因此这里的关键时刻是在应用 VBA 时使用该范围内的最新排序

谢谢

【问题讨论】：

标签： excel vba sorting

【解决方案1】：

这是我会使用的。如果您在实际排序中使用CustomOrder，请告诉我

Sub RRC()

  Dim currWorksheet As Worksheet
  Set currWorksheet = ActiveWorkbook.Worksheets("All_list")
  Dim newRangeSort As Range
  Dim newRangeKey As Range

  ' Fields to be sorted
  Set newRangeSort = currWorksheet.Range("AU2:AU4")
  ' "Header" column of which to sort from
  Set newRangeKey = currWorksheet.Range("AU1")

  'Your sort
  Dim customSort As String
  customSort = ("test")

  'Actual sort
  currWorksheet.Sort.SortFields.Clear
  newRangeSort.Sort Key1:=newRangeKey, Order1:=xlAscending, Header:=xlGuess, _
      OrderCustom:=Application.CustomListCount + 1, MatchCase:=False, _
      Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

  ' clean up
  Set currWorksheet = Nothing

End Sub

这里没有理由使用With。这是一种更好的自定义排序方式，因为使用 vba - Application.AddCustomList 只是一种糟糕的做事方式 - 非常不友好

【讨论】：

谢谢您的回复，刚刚搞清楚是什么问题，用Jiont for CustomOrder
太棒了。我建议添加您的解决方案作为答案，以防其他人遇到同样的问题

【解决方案2】：

这是我在进行一些 intzernet 研究后所做的：

    Sub Segment()

Dim x() As Variant

With Sheets("All_list")

.Range("AP2:AP10").Clear
.Range("AO2:AO10" & .Cells(.Rows.Count, "AO").End(xlUp).Row).Copy
.Range("AP2").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

x = Application.Transpose(Sheets("All_list").Range("AP2:AP10").Value)

ActiveWorkbook.Worksheets("All_list").ListObjects("All").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("All_list").ListObjects("All").Sort.SortFields.Add2 _
        Key:=Range("All[Segment]"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        CustomOrder:=Join(x, ","), DataOption:=xlSortNormal

End With

    With ActiveWorkbook.Worksheets("All_list").ListObjects("All").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


End Sub

第一个范围只是将粘贴代码单元格复制到文本中，否则宏不运行，允许加入跳过在 excel 中创建自定义列表

【讨论】：