过滤然后排序

问题描述 投票：0回答：1

我有一个有效的代码，但是我正在努力清理我使用的代码。 此代码存储在 ThisWorkbook 中并在 Workbook_BeforeClose(Cancel As Boolean) 下运行。 有没有更干净的方法来做到这一点，而不是缩短它。由于它使用过滤器和排序，因此每天设置之间有 3 个空白列。 每天都有不同的时间。

Private Sub Workbook_BeforeClose(Cancel As Boolean)

' Sort Macro
 '
Application.ScreenUpdating = False

Worksheets("RoadMap").Activate
    Range("C3:D151").Select '''Selects column
    Application.DeleteCustomList ListNum:=5
    Application.AddCustomList ListArray:=Array("TRN", "PIT-G", "PIT-D", "PIT-S", "F-230A", "F-330A", "F-430A", "F-830A", "F-930A", "F-1030A", "F-1130A", "F-1230P", "F-130P", "F-230P", "F-430P", "F-530P", "F-630P", "F-730P", "F-830P", "F-930P", "4AM", "5AM", "T-6AM", "8AM", "9AM", "10AM", "11AM", "12PM", "1PM", "2PM", "3PM", "4PM", "5PM", "T-6PM", "6PM", "7PM", "8PM", "9PM", "10PM", "11PM") 'Column contains these starts to be in this order
       '''''Data will be added daily and sorted into proper order
    ActiveWorkbook.Worksheets("RoadMap").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("RoadMap").Sort.SortFields.Add Key:=Range("C3:C151"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= "TRN,PIT-G,PIT-D,PIT-S,F-230A,F-330A,F-430A,F-830A,F-930A,F-1030A,F-1130A,F-1230P,F-130P,F-230P,F-430P,F-530P,F-630P,F-730P,F-830P,F-930P,4AM,5AM,T-6AM,8AM,9AM,10AM,11AM,12PM,1PM,2PM,3PM,4PM,5PM,T-6PM,6PM,7PM,8PM,9PM,10PM,11PM", DataOption:=xlSortNormal 

With ActiveWorkbook.Worksheets("RoadMap").Sort
    .SetRange Range("C2:D151")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
 '''''Repeats for each column that has the data for days of the week M-S
    Range("H3:I151").Select 'repeats previous for the next range of columns with data
    Application.DeleteCustomList ListNum:=5
    Application.AddCustomList ListArray:=Array("TRN", "PIT-G", "PIT-D", "PIT-S", _
    "F-230A", "F-330A", "F-430A", "F-830A", "F-930A", "F-1030A", "F-1130A", "F-1230P", "F-130P", "F-230P", "F-430P", "F-530P", "F-630P", "F-730P", "F-830P", "F-930P", "4AM", "5AM", _
    "T-6AM", "8AM", "9AM", "10AM", "11AM", "12PM", "1PM", "2PM", "3PM", "4PM", "5PM", "T-6PM", "6PM", "7PM", "8PM", "9PM", "10PM", "11PM")
  'sorting order
    ActiveWorkbook.Worksheets("RoadMap").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("RoadMap").Sort.SortFields.Add Key:=Range("H4:H151"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= "TRN,PIT-G,PIT-D,PIT-S,F-230A,F-330A,F-430A,F-830A,F-930A,F-1030A,F-1130A,F-1230P,F-130P,F-230P,F-430P,F-530P,F-630P,F-730P,F-830P,F-930P,4AM,5AM,T-6AM,8AM,9AM,10AM,11AM,12PM,1PM,2PM,3PM,4PM,5PM,T-6PM,6PM,7PM,8PM,9PM,10PM,11PM", DataOption:=xlSortNormal
 'sorting
With ActiveWorkbook.Worksheets("RoadMap").Sort
    .SetRange Range("H3:I151")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
'next column
Range("M3:N151").Select
    Application.DeleteCustomList ListNum:=5
    Application.AddCustomList ListArray:=Array("TRN", "PIT-G", "PIT-D", "PIT-S", "F-230A", "F-330A", "F-430A", "F-830A", "F-930A", "F-1030A", "F-1130A", "F-1230P", "F-130P", "F-230P", "F-430P", "F-530P", "F-630P", "F-730P", "F-830P", "F-930P", "4AM", "5AM", "T-6AM", "8AM", "9AM", "10AM", "11AM", "12PM", "1PM", "2PM", "3PM", "4PM", "5PM", "T-6PM", "6PM", "7PM", "8PM", "9PM", "10PM", "11PM")
'sorting order
ActiveWorkbook.Worksheets("RoadMap").Sort.SortFields.Clear 
ActiveWorkbook.Worksheets("RoadMap").Sort.SortFields.Add Key:=Range("M4:M151"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= "TRN,PIT-G,PIT-D,PIT-S,F-230A,F-330A,F-430A,F-830A,F-930A,F-1030A,F-1130A,F-1230P,F-130P,F-230P,F-430P,F-530P,F-630P,F-730P,F-830P,F-930P,4AM,5AM,T-6AM,8AM,9AM,10AM,11AM,12PM,1PM,2PM,3PM,4PM,5PM,T-6PM,6PM,7PM,8PM,9PM,10PM,11PM", DataOption:=xlSortNormal
'sorting
With ActiveWorkbook.Worksheets("RoadMap").Sort
    .SetRange Range("M3:N151")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
'next column
Range("R3:S151").Select
    Application.DeleteCustomList ListNum:=5
    Application.AddCustomList ListArray:=Array("TRN", "PIT-G", "PIT-D", "PIT-S", "F-230A", "F-330A", "F-430A", "F-830A", "F-930A", "F-1030A", "F-1130A", "F-1230P", "F-130P", "F-230P", "F-430P", "F-530P", "F-630P", "F-730P", "F-830P", "F-930P", "4AM", "5AM",  "T-6AM", "8AM", "9AM", "10AM", "11AM", "12PM", "1PM", "2PM", "3PM", "4PM", "5PM", "T-6PM", "6PM", "7PM", "8PM", "9PM", "10PM", "11PM")
'sorting order
ActiveWorkbook.Worksheets("RoadMap").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("RoadMap").Sort.SortFields.Add Key:=Range("R4:R151"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= "TRN,PIT-G,PIT-D,PIT-S,F-230A,F-330A,F-430A,F-830A,F-930A,F-1030A,F-1130A,F-1230P,F-130P,F-230P,F-430P,F-530P,F-630P,F-730P,F-830P,F-930P,4AM,5AM,T-6AM,8AM,9AM,10AM,11AM,12PM,1PM,2PM,3PM,4PM,5PM,T-6PM,6PM,7PM,8PM,9PM,10PM,11PM", DataOption:=xlSortNormal
'sorting
With ActiveWorkbook.Worksheets("RoadMap").Sort
    .SetRange Range("R3:S151")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
'next column
Range("W3:X151").Select
    Application.DeleteCustomList ListNum:=5
    Application.AddCustomList ListArray:=Array("TRN", "PIT-G", "PIT-D", "PIT-S", "F-230A", "F-330A", "F-430A", "F-830A", "F-930A", "F-1030A", "F-1130A", "F-1230P", "F-130P", "F-230P", "F-430P", "F-530P", "F-630P", "F-730P", "F-830P", "F-930P", "4AM", "5AM", "T-6AM", "8AM", "9AM", "10AM", "11AM", "12PM", "1PM", "2PM", "3PM", "4PM", "5PM", "T-6PM", "6PM", "7PM", "8PM", "9PM", "10PM", "11PM")
'sorting order
ActiveWorkbook.Worksheets("RoadMap").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("RoadMap").Sort.SortFields.Add Key:=Range("W4:W151"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= "TRN,PIT-G,PIT-D,PIT-S,F-230A,F-330A,F-430A,F-830A,F-930A,F-1030A,F-1130A,F-1230P,F-130P,F-230P,F-430P,F-530P,F-630P,F-730P,F-830P,F-930P,4AM,5AM,T-6AM,8AM,9AM,10AM,11AM,12PM,1PM,2PM,3PM,4PM,5PM,T-6PM,6PM,7PM,8PM,9PM,10PM,11PM", DataOption:=xlSortNormal
'sorting
With ActiveWorkbook.Worksheets("RoadMap").Sort
    .SetRange Range("W3:X151")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
 '''next column
Range("AB3:AC151").Select
    Application.DeleteCustomList ListNum:=5
    Application.AddCustomList ListArray:=Array("TRN", "PIT-G", "PIT-D", "PIT-S", "F-230A", "F-330A", "F-430A", "F-830A", "F-930A", "F-1030A", "F-1130A", "F-1230P", "F-130P", "F-230P", "F-430P", "F-530P", "F-630P", "F-730P", "F-830P", "F-930P", "4AM", "5AM", "T-6AM", "8AM", "9AM", "10AM", "11AM", "12PM", "1PM", "2PM", "3PM", "4PM", "5PM", "T-6PM", "6PM", "7PM", "8PM", "9PM", "10PM", "11PM")
'sorting order
ActiveWorkbook.Worksheets("RoadMap").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("RoadMap").Sort.SortFields.Add Key:=Range("AB4:AB151"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= "TRN,PIT-G,PIT-D,PIT-S,F-230A,F-330A,F-430A,F-830A,F-930A,F-1030A,F-1130A,F-1230P,F-130P,F-230P,F-430P,F-530P,F-630P,F-730P,F-830P,F-930P,4AM,5AM,T-6AM,8AM,9AM,10AM,11AM,12PM,1PM,2PM,3PM,4PM,5PM,T-6PM,6PM,7PM,8PM,9PM,10PM,11PM", DataOption:=xlSortNormal
'sorting
With ActiveWorkbook.Worksheets("RoadMap").Sort
    .SetRange Range("AB3:AC151")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
'next column
Range("AG3:AH151").Select
    Application.DeleteCustomList ListNum:=5
    Application.AddCustomList ListArray:=Array("TRN", "PIT-G", "PIT-D", "PIT-S", "F-230A", "F-330A", "F-430A", "F-830A", "F-930A", "F-1030A", "F-1130A", "F-1230P", "F-130P", "F-230P", "F-430P", "F-530P", "F-630P", "F-730P", "F-830P", "F-930P", "4AM", "5AM", "T-6AM", "8AM", "9AM", "10AM", "11AM", "12PM", "1PM", "2PM", "3PM", "4PM", "5PM", "T-6PM", "6PM", "7PM", "8PM", "9PM", "10PM", "11PM")
''' column sort
ActiveWorkbook.Worksheets("RoadMap").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("RoadMap").Sort.SortFields.Add Key:=Range("AG4:AG151"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= "TRN,PIT-G,PIT-D,PIT-S,F-230A,F-330A,F-430A,F-830A,F-930A,F-1030A,F-1130A,F-1230P,F-130P,F-230P,F-430P,F-530P,F-630P,F-730P,F-830P,F-930P,4AM,5AM,T-6AM,8AM,9AM,10AM,11AM,12PM,1PM,2PM,3PM,4PM,5PM,T-6PM,6PM,7PM,8PM,9PM,10PM,11PM", DataOption:=xlSortNormal

With ActiveWorkbook.Worksheets("RoadMap").Sort
    .SetRange Range("AG3:AH151")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

Range("A2").Select

End Sub
excel vba sorting filter
1个回答
0
投票

使用循环缩短代码：自定义排序数据

Sub SortData()

    Const SORT_LIST As String = "" _
        & "TRN,PIT-G,PIT-D,PIT-S,F-230A," _
        & "F-330A,F-430A,F-830A,F-930A,F-1030A," _
        & "F-1130A,F-1230P,F-130P,F-230P,F-430P," _
        & "F-530P,F-630P,F-730P,F-830P,F-930P," _
        & "4AM,5AM,T-6AM,8AM,9AM," _
        & "10AM,11AM,12PM,1PM,2PM," _
        & "3PM,4PM,5PM,T-6PM,6PM," _
        & "7PM,8PM,9PM,10PM,11PM"
    Const DAYS_COUNT As Long = 7
    Const COLUMN_OFFSET As Long = 5
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Sheets("RoadMap")
    Dim rg As Range: Set rg = ws.Range("C3:D151")
    
    Application.ScreenUpdating = False
    
    Dim srg As Range, n As Long
        
    For n = 1 To DAYS_COUNT
        Set srg = rg.Offset(, (n - 1) * COLUMN_OFFSET)
        Debug.Print n, srg.Address
        With ws.Sort
            With .SortFields
                .Clear
                .Add _
                    Key:=srg.Columns(1), _
                    SortOn:=xlSortOnValues, _
                    Order:=xlAscending, _
                    CustomOrder:=SORT_LIST, _
                    DataOption:=xlSortNormal
            End With
            .SetRange srg
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .Apply
        End With
    Next n
    
    Application.ScreenUpdating = True

End Sub
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.