在一个Excel工作表上添加超过1个时间戳

Question

我有一些问题...

我有一个工作表可以跟踪CRM管道活动，并且更改的每个状态都会通过时间戳记录...但是，我不知道如何制作一个以上的时间戳记...

在这里条件：

• 单元格“ a”将为范围和触发，然后单元格“ b”将为 目标时间戳I。

• 目标时间戳

• 单元格“ p”将是范围和触发，然后单元格“ q”为目标时间戳iii。

• 单元格“ AA”将是范围和触发，然后单元格“ AB”将为目标时间戳IV。

• 范围和触发值可以为数字和/或文本。

这是我的工作表代码：

Private Sub Worksheet_Change(ByVal Target As Range)

Dim myTableRange1 As Range
Dim myTrigger1 As Range
Dim myUpdatedRange1 As Range

'Your data table range
Set myTableRange1 = Range("B6:B50000")

'Check if the changed cell is in the data tabe or not.
If Intersect(Target, myTableRange1) Is Nothing Then Exit Sub

'Stop events from running
Application.EnableEvents = False

'Column for the date/time
Set myTrigger1 = Range("B" & Target.Row)

'Column for last updated date/time
Set myUpdatedRange1 = Range("G" & Target.Row)

'Determine if the input date/time should change
If myTrigger1.Value = "" Then

myUpdatedRange1.Value = Now   

End If

'Update the updated date/time value
myUpdatedRange1.Value = Now

'Turn events back on
Application.EnableEvents = True
End Sub

Answer 1

工作表更改：多个时间戳列，

• 这只有在“时间戳牢房”为空白时，才会添加时间戳。

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Const FirstRow As Long = 6
    Const ColumnsRangeAddress As String = "A:A,G:G,P:P,AA:AA"
    
    Dim srg As Range: Set srg = Intersect(Rows(FirstRow) _
        .Resize(Rows.Count - FirstRow + 1), Range(ColumnsRangeAddress))
    
    Dim irg As Range: Set irg = Intersect(srg, Target)
    If irg Is Nothing Then Exit Sub
    
    Dim drg As Range
    Dim iCell As Range
    
    For Each iCell In irg.Cells ' 'A,G,P,AA'
        With iCell.Offset(, 1) ' 'B,H,Q,AB'
            If Len(CStr(.Value)) = 0 Then ' is blank
                If drg Is Nothing Then
                    Set drg = .Cells
                Else
                    Set drg = Union(drg, .Cells)
                End If
            'Else ' is not blank; do nothing
            End If
        End With
    Next iCell
    
    If drg Is Nothing Then Exit Sub
    
    Application.EnableEvents = False ' before writing
    drg.Value = Now
    Application.EnableEvents = True ' after writing

End Sub