Расчет листа - изменение цвета шрифта при изменении значения ячейки

Question

Я искал часы, но изо всех сил пытался найти ответ.

У меня есть рабочая книга с различными запросами.Я ограничил один лист ручным вычислением, и я пытаюсь найти макрос, который затем запустит вычисления вручную и изменит цвет шрифта измененных ячеек.

В настоящее время я использую функцию worksheet_calculate(), ноЯ не могу понять, как заставить его выбрать отдельные изменения ячейки после расчета и изменить цвет шрифта.

Заранее спасибо!

Answer 1

Вы можете использовать application.evaluate, оценить ваши формулы и сравнить их с текущим значением:

    Sub tst()
    For Each cl In Sheet1.Cells.SpecialCells(xlCellTypeFormulas)
        If Application.Evaluate(cl.Formula) <> cl.Value Then
            cl.Interior.ColorIndex = 3
        Else
            cl.Interior.ColorIndex = xlNone
        End If
    Next cl
' application.calculate or sheet calculate
    End Sub

Answer 2

Вам нужно прочитать все значения в массив до вычисления, чтобы вы могли сравнить его со значениями после вычисления:

Option Explicit

Sub ColorChangedCellsAfterCalculation()
    Dim RangeToCheck As Range 'define which range we want to check
    Set RangeToCheck = Worksheets("Sheet1").Range("A1:C5")

    'read values BEFORE calculation into array
    Dim PreCalcValues As Variant
    PreCalcValues = RangeToCheck.Value

    'calculate
    Application.Calculate

    'read values AFTER calculation into array
    Dim PostCalcValues As Variant
    PostCalcValues = RangeToCheck.Value

    Dim ChangedData As Range 'we collect all changed cells in this variable

    'Loop through array and check which row/column values changed
    Dim iRow As Long, iCol As Long
    For iRow = 1 To RangeToCheck.Rows.Count
        For iCol = 1 To RangeToCheck.Columns.Count
            If PreCalcValues(iRow, iCol) <> PostCalcValues(iRow, iCol) Then
                If ChangedData Is Nothing Then 'collect all changed data
                    Set ChangedData = RangeToCheck(iRow, iCol) 'first changed cell
                Else
                    Set ChangedData = Union(ChangedData, RangeToCheck(iRow, iCol)) 'add all other changed cells
                End If
            End If
        Next iCol
    Next iRow

    If Not ChangedData Is Nothing Then ChangedData.Interior.Color = vbRed 'mark all changed data red
End Sub

Представьте себе следующие данные ...

Это превратится в ...

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