Question

我不希望在单元格为空时执行此代码。当我尝试删除单元格的内容时，此代码会添加Now。

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Target.Column = 1 Then
        Range("E" & Target.Row) = Now()
    End If
End Sub

Answer 1

这是你在尝试的吗？

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Whoa

    If Target.Cells.CountLarge > 1 Then Exit Sub

    Application.EnableEvents = False

    If Not Intersect(Target, Columns(1)) Is Nothing Then
        If Target.Value <> "" Then Target.Offset(, 4).Value = Now
    End If

Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

有关Worksheet_Change的更多说明，请HERE

修改：

我尝试过测试不起作用！日期没有显示不知道哪里错了！ - Horby 6小时前

以上代码适用于一个工作表，应粘贴在相关的表单区域中。如果您想使其适用于所有工作表，请使用以下代码并将其粘贴到ThisWorkbook代码区域

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    On Error GoTo Whoa

    If Target.Cells.CountLarge > 1 Then Exit Sub

    Application.EnableEvents = False

    If Not Intersect(Target, Columns(1)) Is Nothing Then
        If Target.Value <> "" Then Target.Offset(, 4).Value = Now
    End If

Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

Answer 2

为防止您的代码在目标为空时执行，只需进行以下小改动：

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Target.Column = 1 And Target.Count = 1 Then
        If Len(Target) Then 
            Application.EnableEvents = False
            Range("E" & Target.Row) = Now()
            Application.EnableEvents = True
        End If
    End If
End Sub

如果将某些内容添加到单元格，请添加“现在”

2 个答案: