Worksheet_Change事件中的Excel VBA Static Timestamp [英] Excel VBA Static Timestamp in Worksheet_Change event
问题描述
我正在创建一个日志,当日志数据最初输入到Cell C时,它会自动将时间戳填充到Cell D中。不幸的是我已经打了墙。
I am working on creating a log that will automatically populate a timestamp into Cell D, when data is initially entered into Cell C. Unfortunately I have hit a wall.
-
当我在单元格C中输入数据时,我可以在单元格D中获取时间戳,但如果我进行任何更改到单元格C,时间戳再次更新。
When I enter data in Cell C, I am able to get the timestamp in Cell D, but if I make any changes to Cell C, the timestamp updates again.
我需要使其功能使得如果单元格C为空白,时间戳将仅在单元格D中更改。
I need to make it function so that the timestamp will ONLY change in Cell D if Cell C is blank.
如果数据已经输入到单元格C,并且时间戳已经加载到单元格D,而且我需要修改单元格C中的内容不希望单元格D的时间戳更改。
If data already has been entered into Cell C, and a timestamp already has been loaded to Cell D, and I need to modify what's in cell C, I don't want the timestamp Cell D to change.
希望是有道理的。 VBA代码如下:
Hope that makes sense. VBA code is as follows:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim rCell As Range
Dim rChange As Range
On Error GoTo ErrHandler
Set rChange = Intersect(Target, Range("C:C"))
If Not rChange Is Nothing Then
Application.EnableEvents = False
For Each rCell In rChange
If rCell > "" Then
With rCell.Offset(0, 1)
.Value = Now
.NumberFormat = "hh:mm:ss AM/PM mm/dd/yyyy"
End With
Else
rCell.Offset(0, 1).ClearContents
End If
Next
End If
ExitHandler:
Set rCell = Nothing
Set rChange = Nothing
Application.EnableEvents = True
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub
任何指导都不胜感激。
Any guidance would be appreciated.
推荐答案
如果在列C中输入值不存在,则将以下时间戳放入列D中。如果列C中的值被清除,列D中的任何现有时间戳也被清除。如果对列C中的条目进行编辑,则不会对现有时间戳进行更改。
The following puts a timestamp into column D if there isn't one there when a value is typed into column C. If the value in column C is cleared, any existing timestamp in column D is also cleared. If an edit is made to an entry in column C, then no change is made to the existing timestamp.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns("C"), Target.Parent.UsedRange) Is Nothing Then
On Error GoTo Safe_Exit
Application.EnableEvents = False
Dim rng As Range
For Each rng In Intersect(Target, Columns("C"), Target.Parent.UsedRange)
If CBool(Len(rng.Value2)) And Not CBool(Len(rng.Offset(0, 1).Value2)) Then
rng.Offset(0, 1) = Now
ElseIf Not CBool(Len(rng.Value2)) And CBool(Len(rng.Offset(0, 1).Value2)) Then
rng.Offset(0, 1) = vbNullString
End If
Next rng
End If
Safe_Exit:
Application.EnableEvents = True
End Sub
此例程将处理多个单元格为Target;通常当几行数据被粘贴到列C中时。它进一步限制了交点到工作表的UsedRange属性,以便在执行行删除操作时使处理最小化。
This routine will handle multiple cells as Target; typically when several rows of data is pasted into column C. It further restricts Intersection to the worksheet's UsedRange property so that processing is minimized when actions like row deletion are performed.
这篇关于Worksheet_Change事件中的Excel VBA Static Timestamp的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!