0

我正在尝试结合两个功能。我有一个 VBA 脚本,它通过一个设定范围并按字母顺序对所有文本列进行排序。

Sub SortIndividualRows()
' 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("A1:NS1")
    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("A87").End(xlUp))
            .Header = xlYes
            .MatchCase = False
            .Apply
        End With
    Next rng
    Application.ScreenUpdating = True
End Sub

我想将此与脚本结合起来,然后按颜色对每一列进行排序。我在手动排序时录制了一个宏,并查看了录制生成的代码。我试图弄清楚如何获取生成的代码并将其与上述函数结合起来。

Sub sortColor()
'
' sortColor Macro
' Goes through a range of selected cells and sorts by color, setting green cells (matches) above those with no match (red text)
'

'
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add(Range("F4:F88"), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(198, _
        239, 206)
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("F3:F88")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
4

1 回答 1

0

澄清一下,您想在之后立即运行一个模块然后再运行另一个模块吗?或者您是否希望每次 for 循环完成时都运行第二个模块的操作?

要一个接一个地运行:

Sub SortIndividualRows() ' 从 AZ 开始对列表中的行进行排序 ' 首先运行 Clean all 以避免对空白进行排序 ' 设置最大范围以避免对太多行进行排序

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

Application.ScreenUpdating = False
Set ws = ActiveSheet
Set rngFirstRow = ws.Range("A1:NS1")
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("A87").End(xlUp))
        .Header = xlYes
        .MatchCase = False
        .Apply
    End With
Next rng

ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add(Range("F4:F88"), _
    xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(198, _
    239, 206)
With ActiveWorkbook.Worksheets("Sheet1").Sort
    .SetRange Range("F3:F88")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Application.ScreenUpdating = True
End Sub

每次 for 循环完成时运行第二个模块:

Sub SortIndividualRows()
' 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("A1:NS1")
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("A87").End(xlUp))
        .Header = xlYes
        .MatchCase = False
        .Apply
    End With


ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add(Range("F4:F88"), _
    xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(198, _
    239, 206)
With ActiveWorkbook.Worksheets("Sheet1").Sort
    .SetRange Range("F3:F88")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

Next rng

Application.ScreenUpdating = True
End Sub
于 2013-07-08T14:59:25.003 回答