3

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

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

这是我的 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
4

1 回答 1

3

这对我有用:

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
于 2013-07-08T20:52:15.107 回答