每次单元格通过公式更改其值时，如何运行 VBA 代码？答案

【问题标题】：How can I run VBA code each time a cell gets its value changed by a formula?每次单元格通过公式更改其值时，如何运行 VBA 代码？
【发布时间】：2021-04-10 02:03:29
【问题描述】：

如何在每次单元格通过公式更改其值时运行 VBA 函数？

当一个单元格的值被用户更改时，我设法运行代码，但是当由于引用另一个单元格的公式而更改值时，它不起作用。

【问题讨论】：

一个特定的单元格，还是任何单元格？您是只想响应手动更改，还是响应重新计算引起的更改？
感谢重播！好吧，它是一个特定的列，我只是为了抓住由重新计算引起的事件。这是我想要做的，在 B 列我有一个公式，比如说 =A1*2，我想要做的是，检查 B 列的这个值何时发生变化。

标签： excel vba formula

【解决方案1】：

如果我在单元格 A1 中有一个公式（例如 = B1 * C1），并且我想在每次 A1 由于单元格 B1 或 C1 的更新而发生更改时运行一些 VBA 代码，那么我可以使用以下内容：

Private Sub Worksheet_Calculate()
    Dim target As Range
    Set target = Range("A1")

    If Not Intersect(target, Range("A1")) Is Nothing Then
    //Run my VBA code
    End If
End Sub

更新

据我所知，Worksheet_Calculate 的问题在于它会触发电子表格中包含公式的所有单元格，并且您无法确定重新计算了哪个单元格（即 Worksheet_Calculate 不提供 Target 对象)

为了解决这个问题，如果您在 A 列中有一堆公式，并且您想确定哪个公式已更新并向该特定单元格添加注释，那么我认为以下代码将实现这一点：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim updatedCell As Range
    Set updatedCell = Range(Target.Dependents.Address)

    If Not Intersect(updatedCell, Range("A:A")) Is Nothing Then
       updatedCell.AddComment ("My Comments")
    End If

End Sub

为了解释，要更新公式，该公式的输入单元格之一必须更改，例如如果A1 中的公式为=B1 * C1，则B1 或C1 必须更改以更新A1。

我们可以使用Worksheet_Change 事件来检测 s/sheet 上的单元格更改，然后使用 Excel 的审核功能来跟踪依赖项，例如单元格 A1 依赖于 B1 和 C1，在这种情况下，代码 Target.Dependents.Address 将返回 $A$1 以对 B1 或 C1 进行任何更改。

鉴于此，我们现在需要做的就是检查依赖地址是否在 A 列中（使用 Intersect）。如果它在 A 列中，我们可以将 cmets 添加到相应的单元格中。

请注意，这只适用于将 cmets 添加到单元格中一次。如果您想继续覆盖同一单元格中的 cmets，则需要先修改代码以检查 cmets 的存在，然后根据需要删除。

【讨论】：

成功了！我只需要一件事，假设我的范围是列范围（“A：A”），我想知道哪个行/单元格的值发生了变化，我该怎么做？再次感谢。我需要做的是 Cells(Target.Row, "A").AddComment Text:="aaaaaaa"
@Cloaky - 据了解，Worksheet_Calculate 事件针对工作表中包含公式的所有单元格运行。因此，我不确定是否可以直接捕获包含多个公式的列中哪个单元格已更新。我可以考虑解决这个问题，但这取决于您的 s/sheet 的结构以及公式的输入位置...

【解决方案2】：

您使用的代码不起作用，因为更改的单元格不是带有公式的单元格，而是单元格...正在更改:)

这是您应该添加到工作表模块的内容：

（更新：如果没有依赖项，“Set rDependents = Target.Dependents”行将引发错误。此更新会处理此问题。）

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rDependents As Range
    
    On Error Resume Next
    Set rDependents = Target.Dependents
    If Err.Number > 0 Then
        Exit Sub
    End If
    ' If the cell with the formula is "F160", for example...
    If Not Application.Intersect(rDependents, Range("F160")) Is Nothing Then
        Call abc
    End If
End Sub

Private Sub abc()
    MsgBox """abc()"" is running now"
End Sub

如果有许多相关的单元格，您可以通过设置相关单元格地址数组来扩展它。然后，您将测试数组中的每个地址（您可以为此使用任何循环结构）并为此运行与更改的单元格相对应的所需子例程（使用 SELECT CASE...）。

【讨论】：

【解决方案3】：

这是使用类的另一种方式。该类可以存储单元格的初始值和单元格地址。在计算事件中，它将地址当前值与存储的初始值进行比较。下面的示例仅用于收听一个单元格（“A2”），但您可以开始收听模块中的更多单元格或更改类以使用更广泛的范围。

名为“Class1”的类模块：

Public WithEvents MySheet As Worksheet
Public MyRange As Range
Public MyIniVal As Variant

Public Sub Initialize_MySheet(Sh As Worksheet, Ran As Range)
    Set MySheet = Sh
    Set MyRange = Ran
    MyIniVal = Ran.Value
End Sub
Private Sub MySheet_Calculate()

If MyRange.Value <> MyIniVal Then
    Debug.Print MyRange.Address & " was changed from " & MyIniVal & " to " & MyRange.Value
    StartClass
End If

End Sub

初始化 normall 模块中的类。

Dim MyClass As Class1

Sub StartClass()
Set MyClass = Nothing
Set MyClass = New Class1
MyClass.Initialize_MySheet ActiveSheet, Range("A2")
End Sub

【讨论】：

无法让它在 Excel 2016 中为我的生命运行。但是看起来很棒。

【解决方案4】：

这是我的代码：

我知道它看起来很糟糕，但它确实有效！当然也有更好的解决方案。

代码说明：

当工作簿打开时，单元格 B15 到 N15 的值保存在变量 PrevValb 到 PrevValn 中。如果发生 Worksheet_Calculate() 事件，则会将先前的值与单元格的实际值进行比较。如果值发生变化，则单元格用红色标记。这段代码可以用函数编写，这样他就更短更容易阅读了。有一个颜色重置按钮 (Seenchanges)，它将颜色重置为以前的颜色。

工作簿：

Private Sub Workbook_Open()
PrevValb = Tabelle1.Range("B15").Value
PrevValc = Tabelle1.Range("C15").Value
PrevVald = Tabelle1.Range("D15").Value
PrevVale = Tabelle1.Range("E15").Value
PrevValf = Tabelle1.Range("F15").Value
PrevValg = Tabelle1.Range("G15").Value
PrevValh = Tabelle1.Range("H15").Value
PrevVali = Tabelle1.Range("I15").Value
PrevValj = Tabelle1.Range("J15").Value
PrevValk = Tabelle1.Range("K15").Value
PrevVall = Tabelle1.Range("L15").Value
PrevValm = Tabelle1.Range("M15").Value
PrevValn = Tabelle1.Range("N15").Value
End Sub

模块：

Sub Seenchanges_Klicken()
Range("B15:N15").Interior.Color = RGB(252, 213, 180)
End Sub

表 1：

Private Sub Worksheet_Calculate()
If Range("B15").Value <> PrevValb Then
    Range("B15").Interior.Color = RGB(255, 0, 0)
    PrevValb = Range("B15").Value
End If
If Range("C15").Value <> PrevValc Then
    Range("C15").Interior.Color = RGB(255, 0, 0)
    PrevValc = Range("C15").Value
End If
If Range("D15").Value <> PrevVald Then
    Range("D15").Interior.Color = RGB(255, 0, 0)
    PrevVald = Range("D15").Value
End If
If Range("E15").Value <> PrevVale Then
    Range("E15").Interior.Color = RGB(255, 0, 0)
    PrevVale = Range("E15").Value
End If
If Range("F15").Value <> PrevValf Then
    Range("F15").Interior.Color = RGB(255, 0, 0)
    PrevValf = Range("F15").Value
End If
If Range("G15").Value <> PrevValg Then
    Range("G15").Interior.Color = RGB(255, 0, 0)
    PrevValg = Range("G15").Value
End If
If Range("H15").Value <> PrevValh Then
    Range("H15").Interior.Color = RGB(255, 0, 0)
    PrevValh = Range("H15").Value
End If
If Range("I15").Value <> PrevVali Then
    Range("I15").Interior.Color = RGB(255, 0, 0)
    PrevVali = Range("I15").Value
End If
If Range("J15").Value <> PrevValj Then
    Range("J15").Interior.Color = RGB(255, 0, 0)
    PrevValj = Range("J15").Value
End If
If Range("K15").Value <> PrevValk Then
    Range("K15").Interior.Color = RGB(255, 0, 0)
    PrevValk = Range("K15").Value
End If
If Range("L15").Value <> PrevVall Then
    Range("L15").Interior.Color = RGB(255, 0, 0)
    PrevVall = Range("L15").Value
End If
If Range("M15").Value <> PrevValm Then
    Range("M15").Interior.Color = RGB(255, 0, 0)
    PrevValm = Range("M15").Value
End If
If Range("N15").Value <> PrevValn Then
    Range("N15").Interior.Color = RGB(255, 0, 0)
    PrevValn = Range("N15").Value
End If
End Sub

【讨论】：