Запускать макрос при изменении любой ячейки, содержащей формулу

Question

У меня есть лист с примерно 50 ячейками (содержащими формулы), который изменяется в зависимости от ячеек во внешней книге.

Я хочу вызвать определенный макрос, когда ЛЮБАЯ из этих ячеек меняет свое значение.

Событие Worksheet_change не работает, и Worksheet_Calculate не ссылается на целевую ячейку, которая изменяется.

Я нашел этот код, но он не поможет, так как он проверяет, изменилось ли только одно значение ячейки ("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

Поэтому я был бы очень признателен за помощь в поиске решения этой проблемы.

Примечание. Все ячейки, содержащие формулы, называются ячейками.

Answer 1

Вы можете хранить значения листа в памяти и при каждой проверке пересчета, которые менялись, одновременно обновляя этот массив.

Вот некоторый код для размещения в ThisWorkbook модуль, который будет иметь такое обнаружение для первого листа (изменить Sheet1 какой лист вы хотите отслеживать):

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 оператор (ы) в последней подпрограмме, чтобы отфильтровать только те диапазоны, которые вас действительно интересуют.

Для всех листов

Если вам нужно отслеживать изменения на нескольких листах, вы можете создать свой кэш, чтобы он представлял собой коллекцию 2D-массивов, по одной записи в коллекции на лист, с указанием имени.

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

Это будет работать для листов, которые существуют с самого начала, а не для листов, которые добавляются. Конечно, это тоже можно сделать, но вы поймете.

Answer 2

Может быть, вы можете начать с этим кодом.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rIntersect As Range
  Set rIntersect = Intersect(Target, Application.names("NameOfRange").RefersToRange)
  If Not rIntersect Is Nothing Then
    MsgBox "found" '<~ change to your liking
  End If
End Sub