Сортировка по цвету шрифта с использованием VBA

Question

Я пытаюсь реализовать кнопку, которая при нажатии сортирует массив сначала по алфавиту, а затем по цвету шрифта. Столбец, который я использую для сортировки, имеет 3 возможных значения (зарегистрировано, в списке ожидания и отменено). Цвет шрифта для «отменен» - серый. Я хочу зарегистрироваться в верхней части списка, затем в списке ожидания, а затем отменить в нижней части. Не должно быть так сложно, но я не могу заставить код работать. Вот код, который я написал. Большое спасибо!

Private Sub btnSort_Click()
Dim SortArray As Range
Dim SortColumn As Range


Set SortArray = Range("A3").CurrentRegion
Set SortColumn = Range(Range("A3").End(xlToRight), Range("A3").End(xlToRight).End(xlDown))

SortArray.Sort Key1:=SortColumn, Header:=xlYes

With SortArray.Sort
    .SortFields.Clear
    .SortFields.Add Key:=SortColumn
    .xlSortOnFontColor
    .SortOnValue.Color = RGB(192, 192, 192)
    .SortOrder = xlAscending
    .Header = xlYes
    .Apply
End With

Answer 1

Поскольку существует только 3 значения, мы используем вспомогательный столбец, а затем присваиваем ему значения.Затем мы сортируем и затем окончательно удаляем вспомогательный столбец.

Допустим, ваши данные выглядят следующим образом

Попробуйте этот код.Я подключил код, поэтому у вас не должно возникнуть проблем с его пониманием.

Sub Sample()
    Dim ws As Worksheet
    Dim lRow As Long, lCol As Long
    Dim rng As Range
    Dim ColName As String

    '~~> Change this to the relevant sheet
    Set ws = Sheet1

    With ws
        '~~> Insert a helper column in Col A
        .Columns(1).Insert Shift:=xlToRight
        .Cells(1, 1).Value = "TmpHeader"

        '~~> Get Last Row and last Column
        '~~> I am assuming that headers are in row 1
        lRow = .Range("B" & .Rows.Count).End(xlUp).Row
        lCol = .Cells(1, Columns.Count).End(xlToLeft).Column
        ColName = Split(Cells(, lCol).Address, "$")(1)

        '~~> Insert the formula in Col A
        .Range("A2:A" & lRow).Formula = "=IF(RC[1]=""enrolled"",1,IF(RC[1]=""waitlisted"",2,3))"

        '~~> Set your range
        Set rng = .Range("A1:" & ColName & lRow)

        '~~> Sort it
        rng.Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

        '~~> Delete the helper column
        .Columns(1).Delete
    End With
End Sub

Когда вы запускаете приведенный выше код, он вставляет вспомогательный столбец, а затем вставляет формулу =IF(B2="enrolled",1,IF(B2="waitlisted",2,3)).присваивает значения 1, 2 и 3 на основе значения, зарегистрировано ли оно, находится в списке ожидания или отменено.

После вставки формулы мыотсортировать по столбцу A в порядке возрастания и затем окончательно удалить вспомогательный столбец.

Answer 2

Разобрался:

ActiveSheet.Range("A3").CurrentRegion.Sort Key1:=Range("I3"), Header:=xlYes

ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add(Range("I3"), _
xlSortOnFontColor, xlDescending, , _
xlSortNormal).SortOnValue.Color = RGB(192, 192, 192)

With ActiveSheet.Sort
   .SetRange Range("A3").CurrentRegion
   .Header = xlYes
   .MatchCase = False
   .Orientation = xlTopToBottom
   .SortMethod = xlPinYin
   .Apply
End With