Question

我想知道每次单元格获取的值是否由公式更改时，如何运行VBA代码？我设法在一个单元格被用户更改其值时运行代码，但它不起作用

Answer 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或{{1}进行任何更改}}

鉴于此，我们现在需要做的就是检查从属地址是否在A列中（使用C1）。如果它在A列中，我们就可以在适当的单元格中添加注释。

请注意，这仅适用于仅向单元格添加一次注释。如果要继续覆盖同一单元格中的注释，则需要先修改代码以检查是否存在注释，然后根据需要进行删除。

Answer 2

您使用的代码不起作用，因为单元格更改不是具有公式的单元格，而是更改的销售...：

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

（未定义：如果没有家属，则“设置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

如果通过设置有问题的单元格地址数组有许多相关单元，则可以展开此项。然后你将测试数组中的每个地址（你可以使用任何循环结构）并运行一个与更改的单元格相对应的desited子例程（使用SELECT CASE ...）。

Answer 3

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

类模块名为＆＃34; Class1＆＃34;：

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

Answer 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

Sheet 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

每次单元格获取的值是否通过公式更改时，如何运行VBA代码？

4 个答案: