Excel VBA实现列值更新时单次捕获日期时间的问题解决

原有代码存在3个核心问题，导致触发逻辑不符合预期：

• 未做值匹配判断：只要K列单元格非空就写入时间，完全没有校验单元格值是否为要求的Performed或Closed
• 未做单次写入限制：无论L列是否已经存在时间戳，事件触发时都会直接覆盖写入，无法实现仅记录一次的效果
• 未做事件防递归处理：代码向L列写入值时会再次触发工作表Change事件，容易造成无意义的重复触发，也会增加异常刷新的概率

将原有代码替换为以下内容，代码需要放在对应工作表的代码模块中（右键点击工作表标签，选择「查看代码」，粘贴到弹出的窗口中即可）：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim monitorRng As Range, Cell As Range
    ' 仅处理K列的单元格变更，非目标列变更直接退出
    Set monitorRng = Intersect(Target, Me.Columns("K"))
    If monitorRng Is Nothing Then Exit Sub
    
    ' 关闭事件触发，避免写入L列时递归触发本事件
    Application.EnableEvents = False
    On Error GoTo RecoverEvent
    
    For Each Cell In monitorRng
        Select Case Trim(Cell.Value)
            ' 匹配指定的两个审计状态
            Case "Performed", "Closed"
                ' 仅当同行L列为空时写入时间，实现单次记录不覆盖
                If VBA.IsEmpty(Me.Cells(Cell.Row, "L").Value) Then
                    Me.Cells(Cell.Row, "L").Value = Now
                    ' 如需固定时间格式，可替换为下面的语句，按需调整格式串即可
                    ' Me.Cells(Cell.Row, "L").Value = Format(Now, "yyyy-mm-dd hh:mm:ss")
                End If
            Case Else
                ' 如果需要状态改回非指定值时清空已记录的时间，可取消下面一行的注释
                ' Me.Cells(Cell.Row, "L").ClearContents
        End Select
    Next Cell

RecoverEvent:
    ' 无论执行是否出错，都恢复事件触发
    Application.EnableEvents = True
End Sub

• 工作簿需要保存为*.xlsm（启用宏的工作簿）格式，打开文件时需要启用宏才能让代码正常生效
• 代码默认严格执行单次记录规则：L列一旦写入时间戳，后续无论怎么修改K列的状态，都不会覆盖原有时间
• 如果需要自定义时间显示格式，取消代码中Format语句的注释，修改yyyy-mm-dd hh:mm:ss为需要的格式即可
• 代码中已经做了异常兜底，哪怕执行过程中报错，也会自动恢复Excel的事件触发开关，不会造成后续所有事件失效的问题

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