Question

我正在使用以下代码尝试将用户带到第一个可用的空行。这被设计为一种转到第一个空行链接。

代码：

  'Go Bottom
    If Target.Address = "$K$3" Then
    Range("A8").End(xlDown).Offset(1, 0).Select
    End If

代码选择最后使用的行，但不会将单元格滚动到视图中。用户仍然需要向下滚动。

请有人告诉我我哪里出错了吗？

完整代码：

Option Explicit
Option Compare Text
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Message
ActiveSheet.DisplayPageBreaks = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False

  'Go Bottom
    If Target.Address = "$K$3" Then
    Range("A8").End(xlDown).Offset(1, 0).Select
    End If


    'Clear Search Box
    If Target.Address = "$L$3:$M$3" Then

    On Error Resume Next
    Target.Cells.Interior.Pattern = xlNone
    Target.Cells.Value = ""
    SendKeys "{F2}"

    Else
    If Target.Address <> "$L$3:$M$3" Then
    Range("L3").Value = "Search Supplier Name, Number"
    End If
    End If





Message:
Application.DisplayAlerts = False
Application.ScreenUpdating = True
Application.DisplayAlerts = True

Exit Sub

End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Message
On Error Resume Next

ActiveSheet.DisplayPageBreaks = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

'Insert Depot Memo Data for user
 Dim oCell As Range, targetCell As Range
    Dim ws2 As Worksheet
    On Error GoTo Message
    If Not Intersect(Target, Range("B:B")) Is Nothing Then ' <-- run this code only if a value in column B has changed
        If Not GetWb("Depot Memo", ws2) Then Exit Sub

        With ws2
            For Each targetCell In Target
                Set oCell = .Range("J1", .Cells(.Rows.Count, "J").End(xlUp)).Find(What:=targetCell.Value, LookIn:=xlValues, LookAt:=xlWhole)
                If Not oCell Is Nothing Then
                    Application.EnableEvents = False



                    'Set Format of cell
                    targetCell.ClearFormats
                    targetCell.Font.Name = "Arial"
                    targetCell.Font.Size = "10"
                    targetCell.Font.Color = RGB(128, 128, 128)
                    targetCell.HorizontalAlignment = xlCenter
                    targetCell.VerticalAlignment = xlCenter
                   targetCell.Borders(xlEdgeBottom).LineStyle = xlContinuous
                    targetCell.Borders(xlEdgeTop).LineStyle = xlContinuous
                   targetCell.Borders.Color = RGB(166, 166, 166)
                   targetCell.Borders.Weight = xlThin



                    targetCell.Offset(0, -1).Value = Now()
                    targetCell.Offset(0, 1).Value = oCell.Offset(0, 1)
                     targetCell.Offset(0, 2).Value = oCell.Offset(0, -2)
                     targetCell.Offset(0, 3).Value = oCell.Offset(0, -7)

                    Application.EnableEvents = True
                End If
            Next
        End With
    End If




Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True



 'Prompt missed on sale
    If Not Intersect(Target, Range("N:N")) Is Nothing And ActiveCell.Value = "Issue Complete" Then
    If Target.Cells.Count < 8 Then
    Dim MSG1 As Variant

    MSG1 = MsgBox("Did Item Miss On-Sale?", vbYesNo, "Feedback")
    If MSG1 = vbYes Then
    Range("O" & ActiveCell.Row).Value = "Yes"
    Else
    Range("O" & ActiveCell.Row).Value = "No"
    End If

    Range("P" & ActiveCell.Row).Value = DateDiff("d", CDate(Format(Range("A" & ActiveCell.Row).Value, "dd/mm/yyyy;@")), Date)


    End If
    End If



 If Not Intersect(Target, Range("D" & ActiveCell.Row)) Is Nothing And Target.Value <> "" Then
 Call PhoneBook2
 End If






'Send Email - Receipt of Issue

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
If Not Intersect(Target, Range("F:F")) Is Nothing Then
If Target.Cells.Count < 8 Then
If Target.Cells.Offset(0, 8).Value = "" Then

Call SendEmail0


End If
End If
End If



'Send Email - Status Change

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
If Not Intersect(Target, Range("N:N")) Is Nothing Then
If Target.Cells.Count < 8 Then
If Target.Cells.Offset(0, 8).Value = "" Then

Call SendEmail


End If
End If
End If


Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True











Message:
Application.DisplayAlerts = False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Exit Sub

End Sub

由于

Answer 1

试试这个......

Application.Goto Range("A8").End(xlDown).Offset(1, 0) , True

Answer 2

你是否尝试过这样：

If Target.Address = "$K$3" Then
Range("A8").End(xlDown).Offset(1, 0).Activate
End If

你也可以找到最后一行，然后又像这样再去一行

Dim lastRowSheetSix As Long
lastRowSheetSix = ThisWorkbook.Worksheets("PrepareEmailTL-RRD").Range("C1").SpecialCells(xlCellTypeLastCell).Row
lastRowSheetSix=lastRowSheetSix+1

lastRowSheetSix。根据需要选择或（激活）

VBA：将用户带到最后一行？

2 个答案: