Question

我有一个简单的问题，宏自动运行后，Excel总是跳到顶部。每当我在任何单元格中进行更改时，宏就会运行。但是，完成后，Excel跳到顶部。我想呆在编辑单元格的地方。我知道有多种方法可以解决此问题。我的解决方案是以下之一。

这是我的代码：

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Dim Selec, LastRow, LastCol, r As Integer
Dim rng As Range

Set Selec = Range(Target.Address)
LastCol = Range("XFD1").End(xlToLeft).Column

If Selec.Row > Range("A" & Rows.Count).End(xlUp).Row Then
    LastRow = Selec.Row
    Cells(Selec.Row, 1).value = Application.WorksheetFunction.Max(Range(Cells(1, 1), Cells(Selec.Row - 1, 1))) + 1
With Cells(Selec.Row, 4).Validation
    .Delete
    .Add Type:=xlValidateList, Operator:=xlBetween, Formula1:="=Parameters!$A$1:$A$3"
End With
Cells(Selec.Row, 4).value = "Not Started"
Else: LastRow = Range("A" & Rows.Count).End(xlUp).Row
End If

Set rng = Range(Cells(1, 1), Cells(LastRow, LastCol))

If Not Application.Intersect(rng, Selec) Is Nothing Then
   For r = 2 To LastRow
       Select Case Cells(r, 4)
           Case "Completed"
               Range(Cells(r, 1), Cells(r, LastCol)).Interior.Color = RGB(146, 208, 80)
        Case "Not Started"
            Range(Cells(r, 1), Cells(r, LastCol)).Interior.Color = RGB(255, 255, 255)
        Case "In Progress"
            Range(Cells(r, 1), Cells(r, LastCol)).Interior.Color = RGB(255, 255, 0)
    End Select
    If IsEmpty(Range(Cells(r, 1), Cells(r, LastCol))) = False Then
        With Range("A" & r & "," & "C" & r & "," & "D" & r)
            .HorizontalAlignment = xlCenter
        End With
        With Range("B" & r & "," & "E" & r & "," & "F" & r)
            .WrapText = True
            .HorizontalAlignment = xlLeft
        End With
    End If
Next r
End If

'Show Only In Progress and Not Started
Worksheets("Task List").Range("A1").AutoFilter Field:=4, Criteria1:=Array("In Progress", "=", "Not Started"), Operator:=xlFilterValues
'Worksheets("Task List").AutoFilter.Sort.SortFields.Add Key:=Range("C1" & Range("C" & Rows.Count).End(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending
Worksheets("Task List").AutoFilter.Sort.SortFields.Add Key:=Range("C:C"), SortOn:=xlSortOnValues, Order:=xlAscending

With Worksheets("Task List").AutoFilter.Sort
    .Header = xlYes
    .Apply
End With
//Without one of the following lines Excel jumps to the top, but I want to stay at the end/selected cell. Uncommenting one of the following three lines solves this problem.

'Range(Target.Address).Select
'Selection.Select
'Selection.Activate

End Sub

Answer 1

似乎跳跃是过滤或排序的副作用。为了防止Excel跳起来，只需在末尾添加以下代码：

Target.Select

以下两行代码也可以使用，但不建议使用：

Selection.Select

或

Selection.Activate

所有这些都应防止Excel跳到顶部并返回到当前选择。

Answer 2

试试这个好先生！这样会在代码的开头创建一个临时视图（称为“ TempView”），然后在该视图的末尾显示该视图，然后立即删除该视图。

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Dim Selec, LastRow, LastCol, r As Integer
Dim rng As Range

ActiveWorkbook.CustomViews.Add ViewName:="TempView", PrintSettings:=True, _
        RowColSettings:=True

Set Selec = Range(Target.Address)
LastCol = Range("XFD1").End(xlToLeft).Column

If Selec.Row > Range("A" & Rows.Count).End(xlUp).Row Then
    LastRow = Selec.Row
    Cells(Selec.Row, 1).Value = Application.WorksheetFunction.Max(Range(Cells(1, 1), Cells(Selec.Row - 1, 1))) + 1
With Cells(Selec.Row, 4).Validation
    .Delete
    .Add Type:=xlValidateList, Operator:=xlBetween, Formula1:="=Parameters!$A$1:$A$3"
End With
Cells(Selec.Row, 4).Value = "Not Started"
Else: LastRow = Range("A" & Rows.Count).End(xlUp).Row
End If

Set rng = Range(Cells(1, 1), Cells(LastRow, LastCol))

If Not Application.Intersect(rng, Selec) Is Nothing Then
   For r = 2 To LastRow
       Select Case Cells(r, 4)
           Case "Completed"
               Range(Cells(r, 1), Cells(r, LastCol)).Interior.Color = RGB(146, 208, 80)
        Case "Not Started"
            Range(Cells(r, 1), Cells(r, LastCol)).Interior.Color = RGB(255, 255, 255)
        Case "In Progress"
            Range(Cells(r, 1), Cells(r, LastCol)).Interior.Color = RGB(255, 255, 0)
    End Select
    If IsEmpty(Range(Cells(r, 1), Cells(r, LastCol))) = False Then
        With Range("A" & r & "," & "C" & r & "," & "D" & r)
            .HorizontalAlignment = xlCenter
        End With
        With Range("B" & r & "," & "E" & r & "," & "F" & r)
            .WrapText = True
            .HorizontalAlignment = xlLeft
        End With
    End If
Next r
End If

'Show Only In Progress and Not Started
Worksheets("Task List").Range("A1").AutoFilter Field:=4, Criteria1:=Array("In Progress", "=", "Not Started"), Operator:=xlFilterValues
'Worksheets("Task List").AutoFilter.Sort.SortFields.Add Key:=Range("C1" & Range("C" & Rows.Count).End(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending
Worksheets("Task List").AutoFilter.Sort.SortFields.Add Key:=Range("C:C"), SortOn:=xlSortOnValues, Order:=xlAscending

With Worksheets("Task List").AutoFilter.Sort
    .Header = xlYes
    .Apply
End With

ActiveWorkbook.CustomViews("TempView").Show
ActiveWorkbook.CustomViews("TempView").Delete

End Sub

过滤/排序后阻止Excel从顶部跳到顶部

2 个答案: