Private Sub Worksheet_Calculate（）

Question

我无法发布图片，所以我想更详细地解释一下我的问题。

我有2个文件：vlookup公式位于目标文件中。 vlookup值位于源文件中。目标文件将被关闭。源文件将被打开。在源文件中，我可能会更改15个单元格值。如果是这样，我希望目标文件（已关闭的工作簿）中的15个单元格突出显示为黄色，因为它们在我打开它时包含vlookup。我希望这能解释我们要解决的问题。

Answer 1

<强>更新

  

您是否知道如何在单元格值更改时在每个单元格中插入注释，而不是突出显示单元格？我想发表评论说，“将细胞从20改为30”。

尝试使用此代码（对于带有公式的大范围可能非常耗时）：

代码模块（标准模块）中的

：

Public cVals As New Dictionary

Sub populateDict()
    Dim rng As Range, c As Range

    With ThisWorkbook.Worksheets("Sheet1")
        Set rng = Intersect(.UsedRange, .Range("CP:CV"))
        If rng Is Nothing Then Exit Sub
        For Each c In rng
            cVals(c.Address) = c.Text
        Next c
        .Calculate
    End With
End Sub

ThisWorkbook模块中的

：

Private Sub Workbook_Open()
    Application.Calculation = xlCalculationManual
    Call populateDict
    Application.Calculation = xlCalculationAutomatic
End Sub

在Sheet模块中

：

Private Sub Worksheet_Calculate()
    Dim rng As Range, c As Range
    Dim rngToColor As Range

    On Error GoTo ErrorHandler

    Application.EnableEvents = False
    'get only used part of the sheet
    Set rng = Intersect(Me.UsedRange, Me.Range("CP:CV"))
    If rng Is Nothing Then GoTo ExitHere ' if there is no formulas in CP:CV - exit from sub

    'reset color for all cells
    rng.Interior.Color = xlNone
    For Each c In rng
        'check if previous value of this cell not equal to current value
        If cVals(c.Address) <> c.Text Then
            'if so (they're not equal), remember this cell
            c.ClearComments
            c.AddComment Text:="Changed value from '" & cVals(c.Address) & "' to '" & c.Text & "'"
        End If
        'store current value of cell in dictionary (with key=cell address)
        cVals(c.Address) = c.Text
    Next c

ExitHere:
    Application.EnableEvents = True
    Exit Sub
ErrorHandler:
    Resume ExitHere
End Sub

请注意，我是uisng Dictionary对象。要使用Dictionary对象，您应该添加对Microsoft Scripting Runtime库的引用。转到工具 - >参考并选择Microsoft Scripting Runtime库：

Answer 2

看起来您想构建类似于交易平台的东西，以突出显示与RTD公式链接的单元格。如果确实如此（或者即使您手动进行更改），也可以使用worksheet_change实现目标。

以下过程查看第12至15列中的单元格（更改的实时值），并在计算发生之前和之后比较FmlaRng（我假设是固定范围）中的值。将表格设置为xlCalculateManual非常重要，否则Excel会在您记录旧值之前计算新值。

另外，我不确定你是否需要保留Application.EnableEvents，但我把它留在那里。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim endrow As Long, startrow As Long, i As Long, j As Long
Dim PreValue As Variant
Dim FmlaRng As Range

Application.EnableEvents = False
Application.Calculation = xlCalculationManual
If Target.Column >= 12 And Target.Column <= 15 Then 'This is where the cell initally changes (the lookupvalue cells)
    On Error GoTo 0
    startrow = 1
    endrow = 1000
    With Workbooks("Workbook2").sheets("Sheet1") 'You need to change these names
    Set FmlaRng = .Range(.Cells(startrow, 94), .Cells(endrow, 100)) 'FmlaRng is where the lookups should be
    FmlaRng.Cells.Interior.ColorIndex = 0
    PreValue = FmlaRng
    Calculate 'This is when vlookups update
    For i = LBound(PreValue, 1) To UBound(PreValue, 1)
        For j = LBound(PreValue, 2) To UBound(PreValue, 2)
            If FmlaRng.Cells(i, j) = PreValue(i, j) Then
            Else
                FmlaRng.Cells(i, j).Interior.ColorIndex = 36
            End If
        Next j
    Next i
    End with
End If
Application.EnableEvents = True
End Sub