Question

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

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

Answer 1

您可以为第二个范围添加ElseIf或者包括I：我在主要检查交叉点并决定在哪里填充时间戳取决于它是B：B还是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：我检查了交叉并使用了VBA的 True =（ - 1）来调整哪个列接收时间戳。

两个时间戳代码同时工作？

1 个答案: