每次單元格通過公式更改其值時，如何運行 VBA 代碼？

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將對B1或C1任何更改返回$A$1 。

鑒於此，我們現在需要做的就是檢查從屬地址是否在 A 列中（使用Intersect ）。 如果它在 A 列中，我們可以在適當的單元格中添加注釋。

請注意，這僅適用於向單元格添加一次注釋。 如果要繼續覆蓋同一單元格中的注釋，則需要修改代碼以首先檢查注釋是否存在，然后根據需要刪除。

Answer 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...）。

Answer 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

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

表 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