Question

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时使用该范围内的最新排序

谢谢

Answer 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只是做事情的一种糟糕方法-非常不友好

Answer 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中创建自定义列表

Excel VBA CustomSort来自范围

2 个答案: