在Excel中按date自动sorting行
我目前正试图在Excel自学自己的VBA代码，但我遇到了一个问题。
我想要Excel做的是根据特定的单元格中input的date自动sorting特定的行。 例如，date只会被input到单元格E36-E40中，并且在input行36-40（ 不包括列A ）时会自动根据最早的date自行sorting。
我已经做了这个macros的logging，它已经吐出这个代码：
Sub AutoSort() Range("B36:H40").Select ActiveWorkbook.Worksheets("SHEET NAME").Sort.SortFields.Clear ActiveWorkbook.Worksheets("SHEET NAME").Sort.SortFields.Add Key:=Range( _ "E37:E40"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ xlSortNormal With ActiveWorkbook.Worksheets("SHEET NAME").Sort .SetRange Range("B36:H40") .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End Sub 我试图使这个自动如下所示，但不工作！
Sub Worksheet_Change1(ByVal Target As Range) If Intersect(Target, Range("E36, E37, E38, E39, E40")) Is Nothing Then Exit Sub Else Sub AutoSort() Range("B36:H40").Select ActiveWorkbook.Worksheets("SHEET NAME").Sort.SortFields.Clear ActiveWorkbook.Worksheets("SHEET NAME").Sort.SortFields.Add Key:=Range( _ "E37:E40"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ xlSortNormal With ActiveWorkbook.Worksheets("SHEET NAME").Sort .SetRange Range("B36:H40") .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End If End Sub End Sub
任何帮助将不胜感激！
使用Range Sort()方法可以得到更简洁的代码：
Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False On Error GoTo ErrHandler If Not Intersect(Target, Range("E36:E40")) Is Nothing Then _ Range("B36:H40").Sort key1:=Range("E36"), order1:=xlAscending, Header:=xlNo, SortMethod:=xlPinYin, DataOption1:=xlSortNormal, MatchCase:=False, Orientation:=xlTopToBottom ErrHandler: Application.EnableEvents = True End Sub
或者将sorting操作封装到一个特定的sub：
Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("E36:E40")) Is Nothing Then AutoSort Range("B36:H40"), Range("E36") End Sub Sub AutoSort(dataRng As Range, orderCol As Range) Application.EnableEvents = False On Error GoTo ErrHandler dataRng.Sort key1:=orderCol, order1:=xlAscending, Header:=xlNo, SortMethod:=xlPinYin, DataOption1:=xlSortNormal, MatchCase:=False, Orientation:=xlTopToBottom ErrHandler: Application.EnableEvents = True End Sub
Me MSDN定义 ：提供了一种方法来引用代码当前正在执行的类或结构的特定实例。
我用Me而不是ActiveWorkbook.Worksheets("SHEET NAME")因为这个代码只与调用事件的工作表有关。 我最初使用ActiveSheet但如果一个macros更改从不同的工作表中的值比该工作表将被激活，它将被sorting。
- 每当从
Worksheet_Change事件更改ActiveSheet上的值时closuresEnableEvents。 这将防止Worksheet_Change事件触发本身导致无限循环和崩溃的Excel。 - 包含一个error handling程序，如果发生错误，将重新打开事件。
- 关键范围从第37行开始
-
.Header = xlYes应该是.Header = xlNo
Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False On Error GoTo ResumeEvents If Not Intersect(Target, Range("E36:E40")) Is Nothing Then With Me .Sort.SortFields.Clear .Sort.SortFields.Add Key:=Range("E36:E40"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With .Sort .SetRange Range("B36:H40") .Header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End With End If ResumeEvents: Application.EnableEvents = True End Sub
不要将您的Subprocedure AutoSort()封装在其他过程中。 将您的AutoSort()过程放在模块中，然后在工作表代码中调用它：
Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("E36, E37, E38, E39, E40")) Is Nothing Then Exit Sub Else AutoSort End If End Sub
另外，如果行36不包含标题， .Header = xlYes更改为.Header = xlNo 。