【问题标题】:Update excel cell with date if a cell in a range is update如果范围内的单元格已更新,则使用日期更新 excel 单元格
【发布时间】:2019-05-29 09:26:43
【问题描述】:

如果在同一行中的任何单元格之前的任何单元格中更新了任何单元格,我需要使用日期和时间戳 (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

安全退出: Application.EnableEvents = True Application.ScreenUpdating = True 结束子

【问题讨论】:

  • 搜索工作表事件Worksheet_Change这就是你需要的,
  • 嗨,替换 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, .... 目标中的每个 trgt..

标签: excel vba excel-formula


【解决方案1】:

这对我有用:

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

【讨论】:

  • Brill 很不错,现在只是想弄清楚如何将它与我当前的上述代码集成
  • 我会做一个 If/ElseIF 满足您的所有需求以及介于两者之间的代码。如果在Application.EnableEvents 之外,应该这样做。
【解决方案2】:

下面的代码负责:

  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

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2015-08-24
    • 1970-01-01
    • 2014-07-10
    • 1970-01-01
    • 1970-01-01
    • 2020-03-22
    相关资源
    最近更新 更多