工作表计算 - 字体颜色随单元格值变化而变化答案

【问题标题】：Worksheet Calculate - Font Colour Change With Cell Value Change工作表计算 - 字体颜色随单元格值变化而变化
【发布时间】：2019-01-22 22:02:50
【问题描述】：

我一直在寻找几个小时，但努力寻找答案。

我有一本包含各种 vlookup 的工作簿。我已将一张纸限制为手动计算，我正在尝试找到一个宏，然后手动运行计算并更改已更改单元格的字体颜色。

我目前正在使用worksheet_calculate() 函数，但我不知道如何让它在计算后挑选出单个单元格的更改并更改字体颜色。

提前致谢！

【问题讨论】：

您要突出显示/更改颜色的单元格？那些在固定的单元格/范围内还是他们的位置在不断变化？
您需要将值读入一个数组（您将找到相关教程），然后运行计算，然后将数组值与新的单元格值进行比较，如果它们改变了颜色。

标签： excel vba

【解决方案1】：

您需要在计算之前将所有值读入一个数组，以便将其与计算之后的值进行比较：

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

想象一下下面的数据……

它会变成……

请注意，如果您在大数据上运行，比较将花费大量时间。因此，不要在整个工作表上运行它，而只能在您想要的数据范围内运行。

【讨论】：

++ 三个建议 :) 1 您可能想要使用 .Cells.SpecialCells(xlCellTypeFormulas) 而不是硬编码范围？要将非连续范围传输到数组，您可能希望看到 This 2 而不是 1 个数组使用 2 个数组。一个计算前和一个计算后然后比较呢？ 3 仅当 ChangedData 为“Not Nothing”时才更改范围的颜色，否则如果 post 和 pre 值相同，您将收到错误 :)
谢谢@PEH - 这看起来很理想。我不确定运行时间是否会成为问题，但我会测试并看看。我现在似乎遇到了一个错误 - 对象变量或未设置块变量......有什么想法吗？
@meg_orm 在哪一行？我测试了代码。如果有变化，它会起作用。检查我编辑的答案我修复了最后一行（如果你的错误在那里）。
@SiddharthRout to 1 当然这可以减少负载。 • 致2 我真的这样做了吗？ • 至3 已修复。感谢您的建议！
@PEH 是的，就是最后一行 'ChangedData.Interior...." 我很确定我已经正确复制了代码，但它仍然抛出错误...？跨度>

【解决方案2】：

您可以使用 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

【讨论】：