Tab 和向右箭头更新上方的行

Question

正在处理一个工作表，该工作表根据用户在 A 列中的输入为本地化时间加上时间戳。如果输入输入并使用“输入”或“向下箭头”移动到下一个单元格或下面的单元格。如果使用“TAB”或“向右箭头”转到右侧的下一个单元格，它会更新当前行上方行中的日期和时间。这是代码：

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim rWatchRange As Range
On Error GoTo ResetEvents
 
'Set range variable to A1:A1000
 Set rWatchRange = Range("A1:A1000")
 
    Dim Test As Double
    Test = LocalOffsetFromGMT()
    Dim first As Integer    'holds number of the first row selected
    Dim last As Integer     'holds number of the last row selected
    
    'assignments to first and last based on user cell selection
    first = Selection.Cells(1, 1).Row
    last = Selection.Cells(0, Selection.Columns.Count).Row
  
 
    'The cell they have changed (Target) _
     is within A1:A1000
    
    Select Case Target.Value

   Case "IP"
   'sets the Actual Start datetime value in columns E and F
           ActiveSheet.Range("E" & last) = Format((Now() + GetCentralOffset / 24), "M/dd/yyyy hh:mm:ss AM/PM")
           ActiveSheet.Range("F" & last) = Format((Now() + GetCentralOffset / 24), "M/dd/yyyy hh:mm:ss AM/PM")
   
   Case "ip"
   'sets the Actual Start datetime value in columns E and F
           ActiveSheet.Range("E" & last) = Format((Now() + GetCentralOffset / 24), "M/dd/yyyy hh:mm:ss AM/PM")
           ActiveSheet.Range("F" & last) = Format((Now() + GetCentralOffset / 24), "M/dd/yyyy hh:mm:ss AM/PM")
    
   Case "NS"
    'clears Actual Start/End datetime values in columns E, F, G, H
            ActiveSheet.Range("E" & last) = ""
            ActiveSheet.Range("F" & last) = ""
            ActiveSheet.Range("G" & last) = ""
            ActiveSheet.Range("H" & last) = ""
            
    Case "ns"
    'clears Actual Start/End datetime values in columns E, F, G, H
            ActiveSheet.Range("E" & last) = ""
            ActiveSheet.Range("F" & last) = ""
            ActiveSheet.Range("G" & last) = ""
            ActiveSheet.Range("H" & last) = ""
            
 
End Select
 
ResetEvents:
Application.EnableEvents = True
End Sub

关于为什么在使用 TAB 和向右箭头时更新上面的行以及如何让它更新正确的行有什么想法吗？

Answer 1

工作表更改：时间戳

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo ClearError
    
    Const rgAddress As String = "A1:A1000"
    Const tColumns As String = "E:F"
    Const cColumns As String = "E:H"
    
    Dim srg As Range: Set srg = Range(rgAddress)
    Dim irg As Range: Set irg = Intersect(srg, Target)
    
    Dim trg As Range
    Dim crg As Range
    Dim iCell As Range
 
    For Each iCell In irg.Cells
        If StrComp(CStr(iCell.Value), "Ip", vbTextCompare) = 0 Then
            If trg Is Nothing Then
                Set trg = iCell.EntireRow.Columns(tColumns)
            Else
                Set trg = Union(trg, iCell.EntireRow.Columns(tColumns))
            End If
        ElseIf StrComp(CStr(iCell.Value), "Ns", vbTextCompare) = 0 Then
            If crg Is Nothing Then
                Set crg = iCell.EntireRow.Columns(cColumns)
            Else
                Set crg = Union(trg, iCell.EntireRow.Columns(cColumns))
            End If
        'Else ' ???
        End If
    Next iCell
     
    Application.EnableEvents = False
     
    If Not trg Is Nothing Then trg.Value = Format((Now() _
        + GetCentralOffset / 24), "M/dd/yyyy hh:mm:ss AM/PM")
    If Not crg Is Nothing Then crg.ClearContents

SafeExit:
    On Error Resume Next
        If Not Application.EnableEvents Then Application.EnableEvents = True
    On Error GoTo 0
    Exit Sub
ClearError:
    Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
    Resume SafeExit
End Sub

Tab 和向右箭头更新上方的行

Tab and right arrow update row above

excel

vba

工作表更改：时间戳