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事件ActiveSheet上的值时，请关闭Worksheet_Change。这将阻止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

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

Answer 3

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

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

按日期在Excel中自动排序行

3 个答案: