当参考范围内的值发生变化时，VBA 更新公式

Posted 2023-04-13

【中文标题】当参考范围内的值发生变化时，VBA 更新公式

【英文标题】：VBA to update formula when a value changes in a refence range

【发布时间】：2017-01-26 15:31:28

【问题描述】：

我有一个 Excel 公式，它在单元格 A1 中为我提供了上周五的日期“=TODAY()-WEEKDAY(TODAY())-1”

我只想在另一个工作表 B2:D469 中的参考范围内的值发生更改时更新单元格 A1。

以下是我正在使用的代码，但问题是代码仅在我手动更改范围时才有效。但是，当源数据透视表刷新时，范围内的值会更新。我希望在刷新数据透视表并且“B2：D469”范围内的值发生变化时更新代码。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range

Set KeyCells = Worksheets.("Source").Range("B2:D469")

If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then

Worksheets.("Dashboard").Range ("A1").EnableCalculation = True

End If
End Sub

【问题讨论】：

您将需要使用 Worksheet_Calculate 事件，问题是它没有 Target，因此很难知道数据是否已更改。您可以包括将数据保存到另一个工作表，然后每次重新计算工作表时，它都会根据存储的数据检查数据，如果不同，则更改值并将新值复制并粘贴到存储中。

嗨，我尝试了 worksheet_Calculate 事件，但它没有用。这是我使用的代码。谢谢 [CODE] Private Sub Worksheet_Calculate(ByVal Target As Range) Dim KeyCells As Range Set KeyCells = Worksheets("Dashboard").Range("G54:J54") If Not Application.Intersect(KeyCells, Range(Target.Address)) _ Is Nothing Then Worksheets("Dashboard").Range("H58") = Format(Date - (Weekday(Date, vbFriday) - 1), "dd-mmm-yy") End If End Sub [代码]跨度>

工作表计算没有ByVal Target As Range，无法添加。您将需要存储数据的副本并检查它是否已更改。然后，如果它更改了复制数据并将其粘贴到旧副本上并更改日期。您不能只添加 ByVal Target As Range 并期望它起作用。

【参考方案1】：

Range.Dependents

Range 有一个属性Dependents，它是一个 Range，其中包含该 Range 影响的所有单元格，即使它们被删除了几个步骤。例如，如果 C4 是“=B4”而 B4 是“=A4”，Range("A4").Dependents 将同时包含 B4 和 C4。

因此，在您的情况下，如果Target 影响您关心的单元格，则它包含在Target.Dependents 范围内。您可以使用它来实现您的目标。

如何使用

使用以下代码作为ThisWorkbook的代码。我已经对此发表了评论，但如果您有任何问题，请随时在 cmets 中提问。

Option Explicit

Private RangeToMonitor As Range
Private RangeToChange As Range

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    '---If this is the first change since the workbook has been opened, define the ranges---
    If RangeToMonitor Is Nothing Then
        Set RangeToMonitor = Worksheets("Source").Range("B2:D469")
        Set RangeToChange = Worksheets("Dashboard").Range("A1")
    End If
    '---------------------------------------------------------------------------------------

    'First, check to see if Target is in the RangeToMonitor
    If Not Application.Intersect(Target, RangeToMonitor) Is Nothing Then
        'If so, set your date. Rather than using a formula in the cell - which could go haywire if someone messes with it - just set it straight from VBA
        RangeToChange.Value = Date - Weekday(Date) - 1
    'Second, check to see if a change to Target *triggers* any recalculation of cells in RangeToMonitor.
    'You can do this by looking at Dependents, which is all the cells affected by a change to Target, even several steps removed
    ElseIf hasDependents(Target) Then
        '(The above and below criteria cannot be done in one if condition because VBA boolean operators do not short circuit)
        If Not (Application.Intersect(Target.Dependents, RangeToMonitor) Is Nothing) Then
            RangeToChange.Value = Date - Weekday(Date) - 1
        End If
    End If
End Sub


'The reason for this function is that trying to use Target.Dependents when Target has no Dependents causes an error
'I use this function to verify that Target DOES have Dependents before attempting to find out if any of them affects RangeToMonitor
Private Function hasDependents(rng As Range)
On Error GoTo ErrHandler
    Dim test As Long
    test = rng.DirectDependents
    hasDependents = True
    Exit Function

ErrHandler:
    If Err.Number = 1004 Then
        '"No Cells Were Found"
        'This error signifies that Target has no Dependents, so we can safely ignore the change and exit the event.
        hasDependents = False
    Else
        Err.Raise Err.Number, , Err.Description
    End If
End Function

【讨论】：

@Dokat 不客气！如果这解决了您的问题，请考虑通过单击投票箭头正下方的绿色复选标记来批准此答案。