按字母顺序和单元格颜色排序

时间:2013-07-08 15:45:41

标签: excel vba excel-vba excel-2010

我正在尝试按字母顺序和单元格颜色对多个列表进行排序,但在一定范围内(因此不需要太长时间)。基本上,VBA假设选择例如列B行3-88,按字母排序,然后按颜色排序。然后转到下一列C3:C88等,直到列NY。

当我尝试它时,我得到运行时错误1004:对象'_Global'的Mathod“范围”失败。

这是我的VBA:

Sub SortAlphaColor()
' Sorts rows within a list from A-Z
' Run Clean all first to avoid sorting blanks
' Set maximum range to avoid sorting too many rows

    Dim rngFirstRow As Range
    Dim rng As Range
    Dim ws As Worksheet

    Application.ScreenUpdating = False
    Set ws = ActiveSheet
    Set rngFirstRow = ws.Range("B3:NY3")
    For Each rng In rngFirstRow
        With ws.Sort
            .SortFields.Clear
            .SortFields.Add Key:=rng, Order:=xlAscending
            'assuming there are no blank cells..
            .SetRange ws.Range(rng, rng.Range("B88").End(xlUp))
                'VBA from second module
                .SortFields.Add(Range(rng), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(198, 239, 206) <- this line is highlighted in debug
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
            .Header = xlYes
            .MatchCase = False
            .Apply
        End With
    Next rng
    Application.ScreenUpdating = True
End Sub

1 个答案:

答案 0 :(得分:2)

这对我有用:

Sub SortAlphaColor()

    Dim rngFirstRow As Range
    Dim rng As Range, rngSort As Range
    Dim ws As Worksheet

    Application.ScreenUpdating = False
    Set ws = ActiveSheet
    Set rngFirstRow = ws.Range("B3:NY3")
    For Each rng In rngFirstRow.Cells
        With ws.Sort

            Set rngSort = rng.Resize(86, 1) 'to row 88

            .SortFields.Clear
            .SortFields.Add Key:=rng, SortOn:=xlSortOnValues, _
                            Order:=xlAscending, DataOption:=xlSortNormal
            .SortFields.Add(rng, xlSortOnCellColor, xlAscending, , xlSortNormal). _
                            SortOnValue.Color = RGB(198, 239, 206)
            .SetRange rngSort
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply

        End With
    Next rng
    Application.ScreenUpdating = True
End Sub