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

时间:2015-09-12 20:41:57

标签: excel excel-vba vba

我不希望在单元格为空时执行此代码。当我尝试删除单元格的内容时,此代码会添加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

2 个答案:

答案 0 :(得分:3)

这是你在尝试的吗?

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

答案 1 :(得分:0)

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

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