0

我需要帮助编写一个代码，当在 I 中输入任何值时，该代码将允许在 H 列中使用日期/时间戳。现在，当在 B 列中输入值时，下面的代码允许在 G 中使用时间戳。我需要做什么？

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("B:B"))
    If Not rChange Is Nothing Then
        Application.EnableEvents = False
        For Each rCell In rChange
            If rCell > "" Then
                With rCell.Offset(0, 5)
                    .Value = Now
                    .NumberFormat = "mm-dd-yy h:mm AM/PM"

                End With
            Else
                rCell.Offset(0, 5).Clear
            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
4

1 回答 1

0

您可以添加ElseIf第二个范围或将 I:I 包含在相交的主要检查中，并根据收到添加/删除/修改的是 B:B 还是 I:I 来决定填充时间戳的位置。我将演示后者。

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("B:B, I:I")) '<- note change
    If Not rChange Is Nothing Then
        Application.EnableEvents = False
        For Each rCell In rChange
            If rCell > "" Then
                With rCell.Offset(0, 5 + (rCell.Column = 9) * 6) '<- note change
                    .Value = Now
                    .NumberFormat = "mm-dd-yy h:mm AM/PM"

                End With
            Else
                rCell.Offset(0, 5 + (rCell.Column = 9) * 6).Clear '<- note change
            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

我已将 I:I 添加到相交检查中，并使用 VBA 的True = (-1) 来调整接收时间戳的列。

于 2015-04-14T00:06:42.400 回答