代码之家 › 专栏 › 技术社区 › Starvsnr

Excel/VBA:在单元格首次更新时创建静态时间戳

timestamp static vba excel

Starvsnr · 技术社区 · 6 月前

我试图在VBA中找到一种方法,在单元格更新时给出时间戳,但我希望时间戳是静态的,只更新一次,即第一次。

A-I列是一个检查表,用户只需在过程完成时输入“X”。 AH-AP列是与上述字段对应的时间戳单元格。

A与AH配对,B与AI配对,以此类推。

因此,如果A2是由用户更新的,我需要AH2有一个静态时间戳。如果B3是由用户更新的,我需要AI3有一个静态时间戳。

目前,我有VBA代码,可以锁定用户输入“X”的单元格和时间戳公式单元格,因此它可以工作,但很笨重。更希望有一种方法可以立即将这些时间戳公式转换为值,VS会定期返回进行更改。

下面是一个模块,我将此代码重复了9次(lockA-lockI),并更改了相应的字段。

Sub lockA()

Application.ScreenUpdating = False

    ActiveSheet.Unprotect
    ActiveSheet.Range("$A$1:$AP$1000").AutoFilter Field:=1, Criteria1:="<>"

    Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Locked = True
    Selection.FormulaHidden = False
    ActiveSheet.Range("$A$1:$AP$1000").AutoFilter Field:=1
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    
Application.ScreenUpdating = True

End Sub

下面是我的工作表:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A2:A1000")) Is Nothing Then
      Call lockA
    End If
    If Not Intersect(Target, Range("B2:B1000")) Is Nothing Then
      Call lockB
    End If
    If Not Intersect(Target, Range("C2:C1000")) Is Nothing Then
      Call lockC
    End If
    If Not Intersect(Target, Range("D2:D1000")) Is Nothing Then
      Call lockD
    End If
    If Not Intersect(Target, Range("E2:E1000")) Is Nothing Then
      Call lockE
    End If
    If Not Intersect(Target, Range("F2:F1000")) Is Nothing Then
      Call lockF
    End If
    If Not Intersect(Target, Range("G2:G1000")) Is Nothing Then
      Call lockG
    End If
    If Not Intersect(Target, Range("H2:H1000")) Is Nothing Then
      Call lockH
    End If
    If Not Intersect(Target, Range("I2:I1000")) Is Nothing Then
      Call lockI
    End If
End Sub

2 回复 | 直到 6 月前

taller 6 月前

所有处理都可以在 Change 活动。

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    ' change in target columns
    If Not Intersect(Target, Range("A2:I1000")) Is Nothing Then
        Application.EnableEvents = False
        Me.Unprotect
        Dim c As Range: Set c = Target.Offset(0, 33) ' timestamp cell
        If IsEmpty(c.Value) Then ' no timestamp in the cell
            c.Value = Now   ' populate cell with timestamp
            c.Locked = True ' lock cell
        End If
        Target.Locked = True    ' lock input cell
        Me.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
        Application.EnableEvents = True
    End If
End Sub

Tim Williams 6 月前

如果您需要处理多单元格更新:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range, c As Range
    
    Set rng = Application.Intersect(Me.Range("A2:I1000"), Target)
    If rng Is Nothing Then Exit Sub
    
    On Error GoTo haveError
    Me.Unprotect
    For Each c In rng.Cells 'check each changed cell in the monitored range
        If UCase(c.Value) = "X" Then
            c.Locked = True
            With c.Offset(0, 33) 'A-->AH, etc
                If Len(.Value) = 0 Then .Value = Now
            End With
        End If
    Next c
haveError:
    Me.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub