通过公式更改单元格内容时如何运行 VBA 代码

How to run VBA code when cell contents are changed via formula

提问by user2221902

The code below works fine when I manually update column I. What I need is to know if there is a way to still have this code work when I have column I updated by a formula.

当我手动更新列 I 时，下面的代码工作正常。我需要知道当我通过公式更新列时，是否有办法使此代码仍然有效。

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    With Target
        If .Count > 1 Then Exit Sub

        If Not Intersect(Range("I3:I30"), .Cells) Is Nothing Then
            Application.EnableEvents = False
            If IsEmpty(.Value) Then
                .Offset(0, -1).ClearContents
            Else
                With .Offset(0, -1)
                    .NumberFormat = "m/d/yy h:mm"
                    .Value = Now
                End With
            End If

            Application.EnableEvents = True
        End If
    End With
End Sub

回答by chris neilsen

Worksheet_Changedoes notfire in responce to a formula update.

Worksheet_Change不会响应公式更新而触发。

See Excel help for Worksheet_Change

请参阅 Excel 帮助 Worksheet_Change

Occurs when cells on the worksheet are changed by the user or by an external link.

You could maybe achieve what you want with the Worksheet_Calculateevent.

您也许可以通过该Worksheet_Calculate活动实现您想要的。

Assuming you want to put a time stamp next to the cells when those vall values change, try this (in addition to your Changeevent).

假设您想在这些 vall 值更改时在单元格旁边放置时间戳，请尝试此操作（除了您的Change事件）。

Note the use of the Staticvariable to track previous values, since Calculateevent does nopt provide a Targetparameter like Changedoes. This method may not be robust enough since Static's get reset if you break vba execution (eg on an unhandled error). If you want it more robust, consider saving previous values on another (hidden) sheet.

请注意使用Static变量来跟踪以前的值，因为Calculateevent 不会Target像do 那样提供参数Change。这种方法可能不够健壮，因为Static如果您中断 vba 执行（例如在未处理的错误上）， ' 将被重置。如果您希望它更健壮，请考虑将以前的值保存在另一个（隐藏的）工作表上。

Private Sub Worksheet_Calculate()
    Dim rng As Range, cl As Range
    Static OldData As Variant

    Application.EnableEvents = False
    Set rng = Me.Range("I3:I30")

    If IsEmpty(OldData) Then
        OldData = rng.Value
    End If

    For Each cl In rng.Cells
        If Len(cl) = 0 Then
            cl.Offset(0, -1).ClearContents
        Else
            If cl.Value <> OldData(cl.Row - rng.Row + 1, 1) Then
                With cl.Offset(0, -1)
                    .NumberFormat = "m/d/yy h:mm:ss"
                    .Value = Now
                End With
            End If
        End If
    Next
    OldData = rng.Value
    Application.EnableEvents = True
End Sub

---

---

Update

更新

Tested routine on sample sheet, all works as expected

样品表上的测试例程，一切都按预期工作

Sample file contains the same code repeated on 25 sheets, and range to time stamp is 10000 rows long.

示例文件包含在 25 张上重复的相同代码，时间戳范围为 10000 行。

To avoid repeating the code, use the Workbook_events. To minimise run time use variant arrays for the loop.

为避免重复代码，请使用Workbook_事件。为了最大限度地减少运行时间，请为循环使用变体数组。

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
    Dim rng As Range
    Dim NewData As Variant

    Dim i As Long
    Static OldData As Variant

    Application.EnableEvents = False
    Set rng = Sh.Range("B2:C10000")  ' <-- notice range includes date column
    NewData = rng

    If IsEmpty(OldData) Then
        OldData = rng.Value
    End If

    For i = LBound(NewData, 1) To UBound(NewData, 1)
        If Len(NewData(i, 1)) = 0 And Len(NewData(i, 2)) > 0 Then
             rng.Cells(i, 2).ClearContents
        Else
            If NewData(i, 1) <> OldData(i, 1) Then
                With rng.Cells(i, 2)
                    .NumberFormat = "m/d/yy -- h:mm:ss"
                    .Value = Now
                End With
            End If
        End If
    Next
    OldData = rng.Value
    Application.EnableEvents = True
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    'Activate date population on cell change
    With Target
        If .Count > 1 Then Exit Sub
        If Not Intersect(Sh.Range("B2:B10000"), .Cells) Is Nothing Then
            Application.EnableEvents = False
            If IsEmpty(.Value) Then
                .Offset(0, 1).ClearContents
            Else
                 'Populate date and time in column c
                With .Offset(0, 1)
                    .NumberFormat = "mm/dd/yyyy -- hh:mm:ss"
                    .Value = Now
                End With
            End If
            Application.EnableEvents = True
        End If
    End With

End Sub