Excel VBA Static Timestamp in Worksheet_Change event

匿名 (未验证) 提交于 2019-12-03 01:54:01

问题:

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.

  • 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.

  • I need to make it function so that the timestamp will ONLY change in Cell D if Cell C is blank.

  • 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.

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.

回答1:

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 

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.



回答2:

Seems simple enough. Am I missing something? Just check to ensure the cell is blank before you update it.

With rCell.Offset(0, 1)     If .Value  "" Then         .Value = Now         .NumberFormat = "hh:mm:ss AM/PM mm/dd/yyyy"     End If End With 


标签
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!