簡體   English   中英

工作表計算 - 字體顏色隨單元格值變化而變化

[英]Worksheet Calculate - Font Colour Change With Cell Value Change

我已經搜索了幾個小時,但一直在努力尋找答案。

我有一個包含各種 vlookups 的工作簿。 我已將一張紙限制為手動計算,並且我正在嘗試找到一個宏,然后該宏將手動運行計算並更改更改單元格的字體顏色。

我目前正在使用worksheet_calculate()函數,但我無法弄清楚如何讓它在計算后挑選出單個單元格更改並更改字體顏色。

提前致謝!

您需要計算將所有值讀入數組以便將其與計算的值進行比較:

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

想象一下以下數據……

在此處輸入圖片說明

會變成……

在此處輸入圖片說明

請注意,如果您在大量數據上運行它,則比較將花費大量時間。 因此,不要在整個工作表上運行它,而只在您想要的數據范圍內運行。

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

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM