如果范围中的单元格已更新,则使用日期更新Excel单元格

时间:2019-05-29 09:26:43

标签: excel vba excel-formula

如果在同一行中的任何单元格之前有任何单元格被更新,我需要使用日期和时间戳(NOW())更新一个单元格。

因此,当“ A-CR”中的任何单元更新时,请使用日期和时间更新单元“ CU”。

我已经做了一些搜索,但是我似乎只能在仅更新单个单元格的情况下找到有效的位,我正在寻找在该范围内是否有任何变化。

我目前有一些Vba,它的功能类似,它将用所需的时间和日期更新相邻的单元格,但是我还需要一个用于整个过程的整体单元格。

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("F:F, I:I, L:L, O:O, R:R, U:U, X:X, AA:AA, AB:AB, AE:AE, AH:AH, AK:AK, AN:AN, AQ:AQ, AT:AT, AW:AW, AZ:AZ, BC:BC, BF:BF, BI:BI, BL:BL, BO:BO, BR:BR, BU:BU, BX:BX, CA:CA, CD:CD, CG:CG, CJ:CJ, CM:CM, CP:CP")) Is Nothing Then
    On Error GoTo safe_exit
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
        Dim trgt As Range, ws1 As Worksheet
        'Set ws1 = ThisWorkbook.Worksheets("Info")
        For Each trgt In Intersect(Target, Range("F:F, I:I, L:L, O:O, R:R, U:U, X:X, AA:AA, AB:AB, AE:AE, AH:AH, AK:AK, AN:AN, AQ:AQ, AT:AT, AW:AW, AZ:AZ, BC:BC, BF:BF, BI:BI, BL:BL, BO:BO, BR:BR, BU:BU, BX:BX, CA:CA, CD:CD, CG:CG, CJ:CJ, CM:CM, CP:CP"))
            If trgt <> vbNullString Then
                If UCase(trgt.Value) = "Y" Or UCase(trgt.Value) = "N" Then
                    Cells(trgt.Row, trgt.Column + 1) = Now()
                    Cells(trgt.Row, trgt.Column + 2) = Environ("username")
                    'Select Case trgt.Column
                    '    Case 2   'column B
                    '        Cells(trgt.Row, trgt.Column + 1) = Environ("username")

                    '     Case 4   'column D
                    '       'do something else
                    ' End Select
                Else
                    trgt = ""
                    Cells(trgt.Row, trgt.Column + 1) = ""
                    Cells(trgt.Row, trgt.Column + 2) = ""
                End If
            End If

        Next trgt
        'Set ws1 = Nothing
    End With
End If

safe_exit:     Application.EnableEvents =真     Application.ScreenUpdating =真 结束

2 个答案:

答案 0 :(得分:0)

这对我有用:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

    Application.EnableEvents = False
    If Intersect(Target, Me.Range("A" & Target.Row & ":CR" & Target.Row)) Is Nothing Then GoTo SafeExit
    Me.Cells(Target.Row, "CU") = Now()
SafeExit:
    Application.EnableEvents = True

End Sub

答案 1 :(得分:0)

以下代码负责:

  1. 清除该行是否为空白的时间。
  2. 仅当这些值确实与先前的值发生变化时才更新时间。
Dim oldValue As String

'Change the range below where your data will be
Const RangeString = "A:CR"

'Below variable decides the column in which date will be displayed
'Change the below value to 1 for column A, 2 for B, ... 99 for CU
Const ColumnIndex = 99

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim WorkRng As Range
    Dim HorizontalRng As Range
    Dim Rng As Range
    Dim HorRng As Range
    Dim RowHasVal As Boolean

    Set WorkRng = Intersect(ActiveSheet.Range(RangeString), Target)

    If Not WorkRng Is Nothing Then
        If WorkRng.Cells.Count = 1 And WorkRng.Cells(1, 1).Value = oldValue Then
            Exit Sub
        End If
        Application.EnableEvents = False
        For Each Rng In WorkRng
            Set HorizontalRng = Intersect(ActiveSheet.Range(RangeString), Rows(Rng.Row))
            RowHasVal = False
            For Each HorRng In HorizontalRng
                If Not VBA.IsEmpty(HorRng.Value) Then
                    RowHasVal = True
                    Exit For
                End If
            Next
            If Not RowHasVal Then
                ActiveSheet.Cells(Rng.Row, ColumnIndex).ClearContents
            ElseIf Not VBA.IsEmpty(Rng.Value) Then
                ActiveSheet.Cells(Rng.Row, ColumnIndex).Value = Now
                ActiveSheet.Cells(Rng.Row, ColumnIndex).NumberFormat = "dd-mm-yyyy, hh:mm:ss"
            End If
        Next
        Application.EnableEvents = True
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, ActiveSheet.Range(RangeString)) Is Nothing Then
        If Target.Cells.Count = 1 Then
            oldValue = Target.Value
        Else
            oldValue = ""
        End If
    End If
End Sub