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

2 番目の範囲の を追加するか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 に答える