当输入某个范围内的值时尝试设置数据（现在）

Question

当在其他单元格中添加值时，我试图在单元格中获取日期（现在）。我正在寻找按专栏来处理这些内容。一个获取值，另一个获取日期。 这被应用于表和某种工作，但是当尝试向我的表添加新行时，宏会创建新列，并将日期应用于创建的所有行。

Private Sub Worksheet_Change(ByVal Target As Range)

Dim MyData As Range
Dim MyDataRng As Range
Set MyDataRng = ActiveSheet.ListObjects("SRFPurchases").ListColumns("Syteline/MTK Requisition").DataBodyRange


If Intersect(Target, MyDataRng) Is Nothing Then Exit Sub

On Error Resume Next
If Target.Offset(0, 1) = "" Then
    Target.Offset(0, 1) = Now
End If

For Each MyData In MyDataRng
    If MyData = "" Then
        MyData.Offset(0, 1).ClearContents
    End If
    
Next MyData
        

End Sub

Answer 1

试试这个：

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim lo As ListObject, rngEntry As Range, rngTS As Range, rng As Range
    Dim c As Range, cTS As Range
    
    Set lo = Me.ListObjects("SRFPurchases") 'the listobject
    Set rngEntry = lo.ListColumns("Syteline/MTK Requisition").DataBodyRange 'column being tracked
    
    Set rng = Application.Intersect(Target, rngEntry) 'changes in tracked column?
    If rng Is Nothing Then Exit Sub 'no changes to track
    
    Set rngTS = lo.ListColumns("TimeStamp").DataBodyRange 'timestamp column
    
    For Each c In rng.Cells      'check each tracked cell
        Set cTS = Application.Intersect(c.EntireRow, rngTS) 'timestamp cell
        If Len(c.Value) > 0 Then 'any value?
            cTS = Now            'add timestamp
        Else
            cTS.ClearContents
        End If
    Next c
    
End Sub