Excel VBA Static Timestamp in Worksheet_Changeイベント

Question

私は、データが最初にセルCに入力されたときに自動的にタイムスタンプをセルDに読み込むログの作成に取り組んでいます。残念ながら私は壁に当たっています。私は、Cell Cにデータを入力すると

• 、私はセルDにタイムスタンプを取得することができるが、私は再びセルCへの変更、タイムスタンプの更新を行います。

• セルCが空白の場合、タイムスタンプがセルD内でのみ変更されるようにする必要があります。

• すでにデータがセルCに入力されていてタイムスタンプが既にセルDにロードされていて、セルCの内容を変更する必要がある場合、タイムスタンプのセルDを変更しないようにします。

希望があります。 VBAコードは次のとおりです。

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 

ご了承ください。

Answer 1

以下は列Dにタイムスタンプを置きます。列Cの項目に対して編集が行われた場合、既存のタイムスタンプは変更されません。

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 

このルーチンは、複数のセルをターゲットとして扱います。通常、列Cに数行のデータが貼り付けられます。行削除などのアクションが実行されると、処理が最小限に抑えられるように、交差点をワークシートのUsedRangeプロパティにさらに制限します。

Answer 2

シンプルなようです。何か不足していますか？セルを更新する前に空白になっていることを確認してください。値は、列Cの値がクリアされると、列Dの既存のタイムスタンプをもクリアされている列Cに入力されたときのものが存在しない場合

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