使用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已取消。

一旦插入公式，我们将按升序对Col 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