简化记录的宏，该宏跨越多个选项卡并在不同的列上排序

时间：2015-11-11 22:47:17

标签： excel vba excel-vba sorting

我已经录制了一个宏，它可以对八个工作表进行自定义排序，并对四列进行排序。我有一个包含九个工作表的工作簿。打开工作簿时，需要对前八个工作表进行排序。第九个工作表是条件格式和错误检查公式的验证页面。

我希望VBA比录制的宏为八个工作表更简单。每个工作表都需要按列B，C，D和E排序。所有数据都从第5行开始，但永远不会在工作表中的同一行结束。我需要对整张纸进行排序，而不仅仅是一个范围。

VBA是否会比为所有八个工作表创建宏更简单？

我确定'For'循环可能会在工作表中循环，xldown会找到每个工作表中的所有数据，但我真的很挣扎如何简化这个以及需要进行。录制的宏中的VBA是：

Sub Auto_Open()
Sort_All Macro
Range("A5").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
ActiveWorkbook.Worksheets("0809 Vehicles").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("0809 Vehicles").Sort.SortFields.Add Key:=Range( _
    "B5:B217"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("0809 Vehicles").Sort.SortFields.Add Key:=Range( _
    "C5:C217"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("0809 Vehicles").Sort.SortFields.Add Key:=Range( _
    "D5:D217"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("0809 Vehicles").Sort.SortFields.Add Key:=Range( _
    "E5:E217"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
With ActiveWorkbook.Worksheets("0809 Vehicles").Sort
    .SetRange Range("A5:Q217")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Sheets("0910 Vehicles ").Select
Range("A5").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
ActiveWorkbook.Worksheets("0910 Vehicles ").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("0910 Vehicles ").Sort.SortFields.Add Key:=Range( _
    "B5:B217"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("0910 Vehicles ").Sort.SortFields.Add Key:=Range( _
    "C5:C217"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("0910 Vehicles ").Sort.SortFields.Add Key:=Range( _
    "D5:D217"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("0910 Vehicles ").Sort.SortFields.Add Key:=Range( _
    "E5:E217"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
With ActiveWorkbook.Worksheets("0910 Vehicles ").Sort
    .SetRange Range("A5:Q217")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Sheets("1011 Vehicles ").Select
Range("A5").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
ActiveWorkbook.Worksheets("1011 Vehicles ").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("1011 Vehicles ").Sort.SortFields.Add Key:=Range( _
    "B5:B215"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("1011 Vehicles ").Sort.SortFields.Add Key:=Range( _
    "C5:C215"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("1011 Vehicles ").Sort.SortFields.Add Key:=Range( _
    "D5:D215"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("1011 Vehicles ").Sort.SortFields.Add Key:=Range( _
    "E5:E215"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
With ActiveWorkbook.Worksheets("1011 Vehicles ").Sort
    .SetRange Range("A5:S215")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Sheets("11-12 Vehicles").Select
Range("A5").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
ActiveWindow.SmallScroll Down:=-234
ActiveWorkbook.Worksheets("11-12 Vehicles").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("11-12 Vehicles").Sort.SortFields.Add Key:=Range( _
    "B5:B237"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("11-12 Vehicles").Sort.SortFields.Add Key:=Range( _
    "C5:C237"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("11-12 Vehicles").Sort.SortFields.Add Key:=Range( _
    "D5:D237"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("11-12 Vehicles").Sort.SortFields.Add Key:=Range( _
    "E5:E237"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
With ActiveWorkbook.Worksheets("11-12 Vehicles").Sort
    .SetRange Range("A5:R237")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Sheets("12-13 Vehicles").Select
Range("A5").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Range("A5:R259").Select
ActiveWorkbook.Worksheets("12-13 Vehicles").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("12-13 Vehicles").Sort.SortFields.Add Key:=Range( _
    "B5:B259"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("12-13 Vehicles").Sort.SortFields.Add Key:=Range( _
    "C5:C259"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("12-13 Vehicles").Sort.SortFields.Add Key:=Range( _
    "D5:D259"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("12-13 Vehicles").Sort.SortFields.Add Key:=Range( _
    "E5:E259"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
With ActiveWorkbook.Worksheets("12-13 Vehicles").Sort
    .SetRange Range("A5:R259")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Sheets("13-14 Vehicles").Select
Range("A5").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
ActiveWorkbook.Worksheets("13-14 Vehicles").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("13-14 Vehicles").Sort.SortFields.Add Key:=Range( _
    "B5:B245"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("13-14 Vehicles").Sort.SortFields.Add Key:=Range( _
    "C5:C245"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("13-14 Vehicles").Sort.SortFields.Add Key:=Range( _
    "D5:D245"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("13-14 Vehicles").Sort.SortFields.Add Key:=Range( _
    "E5:E245"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
With ActiveWorkbook.Worksheets("13-14 Vehicles").Sort
    .SetRange Range("A5:T245")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Sheets("14-15 Vehicles").Select
Range("A5").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
ActiveWorkbook.Worksheets("14-15 Vehicles").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("14-15 Vehicles").Sort.SortFields.Add Key:=Range( _
    "B5:B249"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("14-15 Vehicles").Sort.SortFields.Add Key:=Range( _
    "C5:C249"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("14-15 Vehicles").Sort.SortFields.Add Key:=Range( _
    "D5:D249"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("14-15 Vehicles").Sort.SortFields.Add Key:=Range( _
    "E5:E249"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
With ActiveWorkbook.Worksheets("14-15 Vehicles").Sort
    .SetRange Range("A5:R249")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Sheets("15-16 Vehicles").Select
Range("A5").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
ActiveWorkbook.Worksheets("15-16 Vehicles").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("15-16 Vehicles").Sort.SortFields.Add Key:=Range( _
    "B5:B234"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("15-16 Vehicles").Sort.SortFields.Add Key:=Range( _
    "C5:C234"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("15-16 Vehicles").Sort.SortFields.Add Key:=Range( _
    "D5:D234"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("15-16 Vehicles").Sort.SortFields.Add Key:=Range( _
    "E5:E234"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
With ActiveWorkbook.Worksheets("15-16 Vehicles").Sort
    .SetRange Range("A5:R234")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
End Sub

1 个答案:

答案 0 :(得分：1)

记录的排序代码通常不仅仅是一点点冗长。把它砍成实际需要的东西当然可以删除很多无用的代码。

Sub Sort_All_Macro()
    Dim v As Long, wsARR As Variant
    Dim lr As Long

    'make an array of the worksheet names
    'some of the ws names seemed to have trailing spaces; the spaces should be removed
    wsARR = Array("0809 Vehicles", "0910 Vehicles", "1011 Vehicles", "11-12 Vehicles", _
                  "12-13 Vehicles", "13-14 Vehicles", "14-15 Vehicles", "15-16 Vehicles")
    'from the first in the array to the last
    For v = LBound(wsARR) To UBound(wsARR)
        'work on each in turn
        With Worksheets(wsARR(v))
            'get the last row in column Q
            lr = .Cells(Rows.Count, "Q").End(xlUp).Row
            'work on A5 to the last row in Q
            With .Range(.Cells(5, 1), .Cells(lr, "Q"))
                'sort on columns E first (can only sort on max 3 columns at a time this way
                .Cells.Sort Key1:=.Columns(5), Order1:=xlAscending, _
                            Orientation:=xlTopToBottom, Header:=xlYes   '<~~ you should know if there is a header or not
                'sort on columns B, C, D (finish off the sort)
                .Cells.Sort Key1:=.Columns(2), Order1:=xlAscending, _
                            Key2:=.Columns(3), Order2:=xlAscending, _
                            Key3:=.Columns(4), Order3:=xlAscending, _
                            Orientation:=xlTopToBottom, Header:=xlYes   '<~~ you should know if there is a header or not
            End With
        End With
    Next v
End Sub

这种排序方法只能在一个三个键列上工作（即没有 key4 参数）。诀窍是先排序第四个，然后排序前三个。

使用With ... End With statement依次引用每个工作表可减少重复引用的数量。 Range变为.Range而Cells变为.Cells，表示它属于With ... End With引用的工作表。

有关远离依赖选择和激活以实现目标的更多方法，请参阅How to avoid using Select in Excel VBA macros。

相关问题
最新问题