excel - 使用 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

标签： excelvba

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 进行排序，然后最后删除辅助列。