如何用静态日期填充 2 列

Question

我使用以下代码，用于在 B 列中填充数据时在 C 列中填充静态日期。

如果在 D 列中填充数据，我还希望在 E 列中填充静态日期。请告知 tq

Private Sub Worksheet_Change(ByVal Target As Range) 
    'Update 20140722 
    Dim WorkRng As Range 
    Dim Rng As Range Dim xOffsetColumn As Integer 
    Set WorkRng = Intersect(Application.ActiveSheet.Range("B:B"), Target) 
    xOffsetColumn = 1 
    If Not WorkRng Is Nothing Then 
        Application.EnableEvents = False 
        For Each Rng In WorkRng 
            If Not VBA.IsEmpty(Rng.Value) Then 
                 Rng.Offset(0, xOffsetColumn).Value = Now 
                 Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy, hh:mm:ss" 
            Else 
                Rng.Offset(0, xOffsetColumn).ClearContents 
            End If 
        Next 
        Application.EnableEvents = True 
    End If 
End Sub

Answer 1

工作表更改：时间戳和清除

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Const fRow As Long = 1 ' possibly 2 or more to exclude headers
    Const cOffset As Long = 1
    
    ' Reference the intersecting range.
    Dim irg As Range ' Intersect
    With Columns("B")
        With .Resize(.Rows.Count - fRow + 1).Offset(fRow - 1)
            'Debug.Print Union(.Cells, .EntireRow.Columns("D")).Address
            Set irg = Intersect(Union(.Cells, .EntireRow.Columns("D")), Target)
        End With
    End With
    If irg Is Nothing Then Exit Sub
    
    Dim trg As Range ' Time
    Dim crg As Range ' Clear
    Dim iCell As Range
    
    ' Combine cells into the Time and Clear ranges.
    For Each iCell In irg.Cells
        If Not VBA.IsEmpty(iCell.Value) Then
            If trg Is Nothing Then Set trg = iCell _
                Else Set trg = Union(trg, iCell)
        Else
            If crg Is Nothing Then Set crg = iCell _
                Else Set crg = Union(crg, iCell)
        End If
    Next iCell
    
    Application.EnableEvents = False
    
    ' Write.
    If Not trg Is Nothing Then
        With trg.Offset(, cOffset)
            .NumberFormat = "dd-mm-yyyy, hh:mm:ss"
            .Value = Now
        End With
    End If
    If Not crg Is Nothing Then
        crg.Offset(, cOffset).ClearContents
    End If
   
    Application.EnableEvents = True

End Sub