任何包含公式的单元格更改时触发宏 [英] Trigger macro when any cell containing formula changes

问题描述

我有一个工作表，其中包含约50个单元(包含公式)，这些单元根据外部工作簿中的单元而变化.

I have a worksheet with about 50 cells (containing formulas) that changes depending on cells in an external workbook.

我想在这些单元格中的任何一个更改其值时触发某个宏.

I want to trigger a certain macro when ANY of these cells changes it's value.

Worksheet_change事件不起作用，Worksheet_Calculate不引用发生更改的目标单元格.

Worksheet_change event doesn't work and Worksheet_Calculate doesn't refer to the target cell that changes.

我找到了这段代码，但是由于它仅测试是否更改了一个单元格值("A1")，因此无济于事.

I found this code but it won't help since it tests if only one cell value is changed ("A1").

Private Sub Worksheet_Calculate()
   Static OldVal As Variant

   If Range("A1").Value <> OldVal Then
      OldVal = Range("A1").Value
      Call Macro
   End If
End Sub

因此，非常感谢您为找到该问题的解决方案所提供的帮助.

So I would really appreciate your help about finding a solution for this problem.

注意:所有包含公式的单元格都称为单元格.

Note: All cells containing formulas are named cells.

推荐答案

您可以将工作表的值保留在内存中，并在每次重新计算检查时更改了值，同时更新了该数组.

You could keep the values of the sheet in memory, and upon each recalculation check which have changed while at the same time updating that array.

将以下代码放置在 ThisWorkbook 模块中，该代码将为第一张工作表设置这种检测方式(将 Sheet1 更改为您想要的任何工作表)监视器):

Here is some code, to place in the ThisWorkbook module, that would have such a detection set up for the first sheet (change Sheet1 to whichever sheet you want to monitor):

Dim cache As Variant

Private Sub Workbook_Open()
    cache = getSheetValues(Sheet1)
End Sub

Private Function getSheetValues(sheet As Worksheet) As Variant
    Dim arr As Variant
    Dim cell As Range

    ' Get last cell in the used range
    Set cell = sheet.Cells.SpecialCells(xlCellTypeLastCell)
    ' Get all values in the range between A1 and that cell
    arr = sheet.Cells.Resize(cell.Row, cell.Column)
    If IsEmpty(arr) Then ReDim arr(0, 0) ' Default if no data at all
    getSheetValues = arr
End Function

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
    Dim current As Variant
    Dim previous As Variant
    Dim i As Long
    Dim j As Long
    Dim prevVal As Variant
    Dim currVal As Variant

    If Sh.CodeName <> Sheet1.CodeName Then Exit Sub
    ' Get the values of the sheet and from the cache
    previous = cache
    current = getSheetValues(Sh)
    For i = 1 To WorksheetFunction.Max(UBound(previous), UBound(current))
        For j = 1 To WorksheetFunction.Max(UBound(previous, 2), UBound(current, 2))
            prevVal = ""
            currVal = ""
            On Error Resume Next ' Ignore errors when out of array bounds
                prevVal = previous(i, j)
                currVal = current(i, j)
            On Error GoTo 0
            If prevVal <> currVal Then
                ' Change detected: call the function that will treat this
                CellChanged Sheet1.Cells(i, j), prevVal
            End If
        Next
    Next
    ' Update cache
    cache = current
ext:
End Sub

Private Sub CellChanged(cell As Range, oldValue As Variant)
    ' This is the place where you would put your logic
    Debug.Print cell.Address & " changed from '" & oldValue & "' to '" & cell.Value & "'"
End Sub

您可以在最后一个例程中使用一些 If 语句，以仅过滤出您真正感兴趣的范围.

You could use some If statement(s) in the last routine to filter out only those ranges you are really interested in.

如果需要监视多个工作表中的更改，则可以将缓存构建为2D数组的集合，每个工作表一个集合项，以其名称为键.

If you need to monitor changes in multiple sheets, you could build your cache to be a collection of 2D arrays, one collection entry per sheet, keyed by its name.

Dim cache As Collection

Private Sub Workbook_Open()
    Dim sheet As Worksheet

    Set cache = New Collection
    ' Initialise the cache when the workbook opens
    For Each sheet In ActiveWorkbook.Sheets
        cache.Add getSheetValues(sheet), sheet.CodeName
    Next
End Sub

Private Function getSheetValues(sheet As Worksheet) As Variant
    Dim arr As Variant
    Dim cell As Range

    ' Get last cell in the used range
    Set cell = sheet.Cells.SpecialCells(xlCellTypeLastCell)
    ' Get all values in the range between A1 and that cell
    arr = sheet.Cells.Resize(cell.Row, cell.Column)
    If IsEmpty(arr) Then ReDim arr(0, 0) ' Default if no data at all
    getSheetValues = arr
End Function

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
    Dim current As Variant
    Dim previous As Variant
    Dim i As Long
    Dim j As Long
    Dim prevVal As Variant
    Dim currVal As Variant

    ' Get the values of the sheet and from the cache
    previous = cache(Sh.CodeName)
    current = getSheetValues(Sh)
    For i = 1 To WorksheetFunction.Max(UBound(previous), UBound(current))
        For j = 1 To WorksheetFunction.Max(UBound(previous, 2), UBound(current, 2))
            prevVal = ""
            currVal = ""
            On Error Resume Next ' Ignore errors when out of array bounds
                prevVal = previous(i, j)
                currVal = current(i, j)
            On Error GoTo 0
            If prevVal <> currVal Then
                ' Change detected: call the function that will treat this
                CellChanged Sheet1.Cells(i, j), prevVal
            End If
        Next
    Next
    ' Update cache
    cache.Remove Sh.CodeName
    cache.Add current, Sh.CodeName
ext:
End Sub

Private Sub CellChanged(cell As Range, oldValue As Variant)
    ' This is the place where you would put your logic
    Debug.Print cell.Address & " changed from '" & oldValue & "' to '" & cell.Value & "'"
End Sub

这将从一开始就适用于工作表，而不适用于已添加的工作表.当然，也可以使它起作用，但是您会明白的.

This would work for sheets that exist from the start, not sheets that are added. Of course, that also could be made to work, but you'll get the idea.

这篇关于任何包含公式的单元格更改时触发宏的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！