更新/更改單元格時自動輸入日期和時間

Question

背景：

如果“感興趣的細胞”通過公式改變值，我希望宏在右側的空單元格上自動記錄時間和日期 。

例如，IF單元（“k3”）改變值，然后在單元格上改變時注冊DATE＆TIME（“L3”）; IF單元（“L3”）不為空，然后在單元（“M3”）中注冊TIME和DATE，依此類推，直到找到空單元。

到目前為止，每當“感興趣的細胞”改變值時，我都無法提示宏。 PS：后者是IF公式 ，輸出2個可能的字符串：“OK”和“ISSUE RISK WARNING”

我試過以下代碼：

Private sub Register_timestamp(ByVal Target As Range)
'This sub registers the date and hour at which the cells in column K:K changed values.

    Dim WorkRng As Range
    Dim Rng As Range
    Dim xOffsetColumn As Integer

    Set WorkRng = Intersect(Application.ActiveSheet.Range("K:K"))

    xOffsetColumn = 1

    If WorkRng Is Nothing Then

        Application.EnableEvents = False

        For Each Rng In WorkRng

        If Not VBA.IsEmpty(Rng.Value) Then
            Rng.Offset(0, xOffsetColumn).Value = Now
            Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy, hh:mm:ss"
        Else
            xOffsetColumn = xOffsetColumn + 1
        End If

        Next

        Application.EnableEvents = True

      End If

End sub

預期產量：

如果我要手動更改受“感興趣的細胞”的IF功能影響的細胞 - 並觸發它 - ，“感興趣的細胞”發生變化的日期和時間，例如： 14/05/2019 21 ：44：21

Answer 1

以下是您實施我的建議的方式。 確保此代碼位於正確的工作表代碼模塊上。

Private Sub Worksheet_Calculate()

    Dim rMonitored As Range
    Dim MonitoredCell As Range
    Dim vSelected As Variant
    Dim aNewValues As Variant
    Dim ixFormulaCell As Long

    On Error Resume Next
    Set rMonitored = Me.Columns("K").SpecialCells(xlCellTypeFormulas)
    On Error GoTo 0
    If rMonitored Is Nothing Then Exit Sub  'No formula cells in column K

    Application.EnableEvents = False    'Disable events to prevent infinite calc loop
    Set vSelected = Selection           'Remember current selection (it may not be a range)

    'Prepare the array that will store the new values, the cells those values are in, and whether or not there was a change
    ReDim aNewValues(1 To rMonitored.Cells.Count, 1 To 3)
        'Column1 = new value
        'Column2 = cell address
        'Column3 = did value change?

    'Get the new value for each formula in column K
    ixFormulaCell = 0
    For Each MonitoredCell In rMonitored.Cells  'The formula cells may not be in a contiguous range
        ixFormulaCell = ixFormulaCell + 1
        aNewValues(ixFormulaCell, 1) = MonitoredCell.Value  'Store the new value
        Set aNewValues(ixFormulaCell, 2) = MonitoredCell    'Store the cell address
    Next MonitoredCell

    Application.Undo    'This will undo the most recent change, which allows us to compare the new vs old to check for formula updates

    ixFormulaCell = 0
    For Each MonitoredCell In rMonitored.Cells
        ixFormulaCell = ixFormulaCell + 1
        'Check if the formula result is different
        If MonitoredCell.Value <> aNewValues(ixFormulaCell, 1) Then
            'Formula result found to be different, record that
            'We can't put the timestamp in now because we still have to redo the most recent change
            aNewValues(ixFormulaCell, 3) = True
        End If
    Next MonitoredCell

    Application.Undo    'Redo the most recent change to put worksheet back in the new state

    'Now that we've completed our comparison and have re-done the most recent change, check what did change and put in a timestamp in the next empty cell in same row
    For ixFormulaCell = LBound(aNewValues, 1) To UBound(aNewValues, 1)
        'Check for formula result change
        If aNewValues(ixFormulaCell, 3) Then
            'Formula result change found, get next empty cell in same row
            With Me.Cells(aNewValues(ixFormulaCell, 2).Row, Me.Columns.Count).End(xlToLeft).Offset(, 1)
                'Next empty cell found, put in the current datetime stamp and format it
                .Value = Now
                .NumberFormat = "dd-mm-yyyy, hh:mm:ss"
            End With
        End If
    Next ixFormulaCell

    vSelected.Select                'Re-select the remembered selection so that this operation is invisible to users
    Application.EnableEvents = True 'Re-enable events so that the next calculation can be monitored for formula changes in cells of interest

End Sub