Question

我有以下代码，一旦我在A栏中添加值，就会自动填充B栏中的日期。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim A As Range, B As Range, Inte As Range, r As Range
    Set A = Range("A:A")
    Set Inte = Intersect(A, Target)
    If Inte Is Nothing Then Exit Sub
    Application.EnableEvents = False
        For Each r In Inte
            If r.Offset(0, 1).Value = "" Then
               r.Offset(0, 1).Value = Date & " " & Time = "hh:mm:ss AM/PM"
            End If
        Next r
    Application.EnableEvents = True
End Sub

我正在寻找的是将当前时间添加到C列。

好的，所以我找到了我正在寻找的东西，但它需要很少修改日期和时间的设置。下面是代码

Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Range, B As Range, Inte As Range, r As Range
Set A = Range("D:D")
Set Inte = Intersect(A, Target)
If Inte Is Nothing Then Exit Sub
Application.EnableEvents = False
    For Each r In Inte
        If r.Value > 0 Then
           r.Offset(0, -3).Value = Date
           r.Offset(0, -3).NumberFormat = "dd-mm-yyyy"
           r.Offset(0, -2).Value = Time
           r.Offset(0, -2).NumberFormat = "hh:mm:ss AM/PM"
        Else
           r.Offset(0, -3).Value = ""
           r.Offset(0, -2).Value = ""
        End If
    Next r
Application.EnableEvents = True
End Sub

使用日期而不是A列自动填充E列并使用时间自动填充列F，而不是列B

如果可能的话，我试图在同一张纸上使用相同的过程但另一个单元格。

Answer 1

虽然您可能会尝试使用SpecialCells在一个命中而不是一个循环中执行此操作，但代码的简单mod将是：

每个范围区域方法

一次性

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim A As Range, B As Range, Inte As Range, r As Range
    Set A = Range("A:A")
    Set Inte = Intersect(A, Target)
    If Inte Is Nothing Then Exit Sub
    Application.EnableEvents = False
    On Error Resume Next
    For Each r In Inte.Areas
       r.Offset(0, 1).Cells.SpecialCells(xlCellTypeBlanks) = Date
       r.Offset(0, 2).Cells.SpecialCells(xlCellTypeBlanks) = Time
    Next r
    Application.EnableEvents = True
End Sub

初步回答

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim A As Range, B As Range, Inte As Range, r As Range
    Set A = Range("A:A")
    Set Inte = Intersect(A, Target)
    If Inte Is Nothing Then Exit Sub
    Application.EnableEvents = False
        For Each r In Inte
            If r.Offset(0, 1).Value = vbNullString Then r.Offset(0, 1).Value = Date 
            If r.Offset(0, 2).Value = vbNullString Then r.Offset(0, 2).Value = Time
        Next r
    Application.EnableEvents = True
End Sub

Answer 2

如果你想：

将当前日期放在Target相邻列空白单元格
将当前时间放在Target相邻列的空白单元格中

然后如下：

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Range("A:A"), Target).Address <> Target.Address Then Exit Sub '<--| exit if all target cells aren't in column "A"
    Application.EnableEvents = False
    If WorksheetFunction.CountBlank(Target.Offset(, 1)) = 0 Then Exit Sub '<--| exit if no blank cells in target adjacent column
    With Target.Offset(, 1).SpecialCells(xlCellTypeBlanks) '<--| reference blank cells in target adjacent column
        .Value = Date '<--| set referenced cells value to the current date
        .Offset(, 1).Value = Time '<--| set referenced cells adjacent ones value to the current time
    End With
    Application.EnableEvents = True
End Sub

如果你想：

将当前日期放在Target相邻列空白单元格
将当前时间放入Target两列偏移空白单元格

然后如下：

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Range("A:A"), Target).Address <> Target.Address Then Exit Sub '<--| exit if all target cells aren't in column "A"
    Application.EnableEvents = False
    On Error Resume Next
    Target.Offset(, 1).SpecialCells(xlCellTypeBlanks).Value = Date '<--|  set target adjacent column blank cells  to the current date
    Target.Offset(, 2).SpecialCells(xlCellTypeBlanks).Value = Time '<--|  set target two columns offset blank cells  to the current time
    Application.EnableEvents = True
End Sub

其中On Error Resume Next用于避免两个不同的If WorksheetFunction.CountBlank(someRange) Then someRange.SpecialCells(xlCellTypeBlanks).Value = someValue语句

通常您会避免On Error Resume Next声明，并确保您处理任何可能的错误。

但是在这种情况下，由于它仅限于sub的最后两个语句，我认为这是一个很好的权衡，有利于代码可读性而不会实际失去控制

当用户在相邻单元格中输入信息时，自动填充2个单元格中的日期和时间

2 个答案: