Excel/VBA实现单元格首次更新时生成静态时间戳

核心需求 #

• A-I列为任务清单，仅在流程完成时输入“X”
• AH-AP列为对应时间戳单元格：A列对应AH列、B列对应AI列，依此类推
• 单元格输入“X”时生成静态时间戳，仅首次更新时生成，无需手动将公式转换为值
• 原代码通过9个重复的lock过程实现锁定，操作繁琐，需优化

原模块代码（lockA示例，lockB-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

优化后的工作表事件代码（中文注释） #

Private Sub Worksheet_Change(ByVal Target As Range)
' 若修改的单元格数量大于1，直接退出
If Target.CountLarge > 1 Then Exit Sub
' 仅处理A2到I1000范围内的单元格修改
If Not Intersect(Target, Range("A2:I1000")) Is Nothing Then
    ' 关闭事件触发，避免循环执行
    Application.EnableEvents = False
    ' 解除工作表保护（密码为check）
    Me.Unprotect Password:="check"
    ' 定位对应时间戳单元格：A列对应AH列（偏移33列），以此类推
    Dim c As Range: Set c = Target.Offset(0, 33)
    ' 若时间戳单元格为空，生成当前时间并锁定
    If IsEmpty(c.Value) Then
        c.Value = Now
        c.Locked = True
    End If
    ' 锁定已输入内容的任务单元格
    Target.Locked = True
    ' 重新保护工作表，保留筛选权限
    Me.Protect Password:="check", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
    ' 恢复事件触发
    Application.EnableEvents = True
End If
End Sub

内容的提问来源于stack exchange，提问作者Starvsnr