Excel VBA CustomSort из диапазона

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

Вот что я сделал после некоторого исследования 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

Answer 2

Это то, что я бы использовал.Дайте мне знать, если есть причина, по которой вы используете 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 - это просто ужасный способ сделать что-то - очень недружелюбно