在 Excel 中按日期自动对行进行排序

Question

我目前正在尝试在 Excel 中自学 VBA 代码，但遇到了问题。

我希望 Excel 做的是根据在特定单元格中输入的日期自动对特定行进行排序。例如，日期将仅输入到单元格 E36-E40 中，并且在输入第 36-40 行（不包括 A 列）时，将自动按照最旧的日期优先排序。

我已经对此进行了宏记录，并吐出了这段代码：

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

任何帮助将不胜感激！

Answer 1

MSDN definition of Me：提供一种方法来引用当前正在执行代码的类或结构的特定实例。

我使用Me 而不是ActiveWorkbook.Worksheets("SHEET NAME")，因为此代码仅与调用事件的工作表相关。我最初使用ActiveSheet，但如果宏更改了不同工作表中的值，则该工作表将处于活动状态并进行排序。

• 关闭EnableEvents，无论何时从Worksheet_Change 事件更改ActiveSheet 的值。这将防止 Worksheet_Change 事件触发自身导致无限循环和崩溃 Excel。
• 包含一个错误处理程序，如果引发错误，它将重新打开事件。
• 键范围从第 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

Answer 2

使用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

或者，将排序操作封装到特定的子中：

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

Answer 3

不要将您的 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。