简体   繁体   English

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

[英]Update excel cell with date if a cell in a range is update

I need to update a cell with the date and time stamp (NOW()) if any cell is updated within any cell before it within that same row.如果在同一行之前的任何单元格中更新了任何单元格,我需要使用日期和时间戳 (NOW()) 更新单元格。

So update cell "CU" with date and time when any cell from "A-CR" is updated.因此,当更新“A-CR”中的任何单元格时,使用日期和时间更新单元格“CU”。

I have done some searching but I can only seem to find bits that work if only updating a single cell, I'm looking for if anything changes within that range.我已经做了一些搜索,但我似乎只能找到只更新单个单元格的位,我正在寻找该范围内是否有任何变化。

I currently have some Vba which does something similar which will update the adjacent cell with time and date which is required but I also need an overall one for the whole process.我目前有一些 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 = True Application.ScreenUpdating = True End Sub安全退出:Application.EnableEvents = True Application.ScreenUpdating = True End Sub

This works for me:这对我有用:

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

The below code takes care of:下面的代码负责:

  1. Clearing the time if the row is blank.如果行为空,则清除时间。
  2. Updating the time only if the values really change from the previous value.仅当值确实与先前值发生变化时才更新时间。
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

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM