如何定位Excel自动重计算的具体单元格及工作表？

优化现有方案：仅处理触发计算的工作表 #

你当前用Worksheet_Calculate处理单个表，但遍历所有表性能差——其实Excel只会对受输入影响的工作表触发Calculate事件。改用工作簿级的Workbook_SheetCalculate事件，只在事件触发时处理当前工作表，无需遍历全工作簿：

1. 打开工作簿的ThisWorkbook代码窗口
2. 粘贴以下代码，预先缓存当前工作表所有公式单元格的值，计算后对比差异：

Private formulaCache As New Dictionary ' 需启用Microsoft Scripting Runtime引用

Private Sub Workbook_Open()
    ' 初始化缓存：仅缓存公式单元格的值
    Dim ws As Worksheet
    Dim cell As Range
    For Each ws In ThisWorkbook.Worksheets
        For Each cell In ws.UsedRange.SpecialCells(xlCellTypeFormulas)
            formulaCache.Add ws.Name & "!" & cell.Address, cell.Value
        Next cell
    Next ws
End Sub

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
    Dim cell As Range
    Dim cellKey As String
    Dim oldVal As Variant
    Dim newVal As Variant
    
    ' 仅处理触发计算的工作表Sh
    On Error Resume Next ' 处理无公式单元格的情况
    For Each cell In Sh.UsedRange.SpecialCells(xlCellTypeFormulas)
        cellKey = Sh.Name & "!" & cell.Address
        oldVal = formulaCache(cellKey)
        newVal = cell.Value
        
        ' 对比新旧值，若变化则记录到数据库
        If Not IsError(oldVal) And Not IsError(newVal) Then
            If oldVal <> newVal Then
                ' 这里写你的数据库记录逻辑，示例：
                Debug.Print "变化单元格：" & cellKey & " 旧值：" & oldVal & " 新值：" & newVal
                formulaCache(cellKey) = newVal ' 更新缓存
            End If
        End If
    Next cell
    On Error GoTo 0
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    ' 记录用户手动输入的单元格
    Dim cell As Range
    For Each cell In Target
        If cell.HasFormula = False Then
            ' 这里写输入值的数据库记录逻辑，示例：
            Debug.Print "用户输入：" & Sh.Name & "!" & cell.Address & " 值：" & cell.Value
            ' 更新缓存中依赖该单元格的公式值（可选，避免缓存过期）
            Dim depCell As Range
            On Error Resume Next
            For Each depCell In cell.Dependents
                formulaCache(Sh.Name & "!" & depCell.Address) = depCell.Value
            Next depCell
            On Error GoTo 0
        End If
    Next cell
End Sub

注意：需要在VBA编辑器中启用Microsoft Scripting Runtime引用（工具→引用→勾选对应项）。

更高效的方案：追踪输入单元格的从属单元格 #

如果工作表公式极多，仅处理触发计算的表仍有性能问题，可以进一步缩小范围：通过用户输入的单元格，直接找到所有跨工作表的从属公式单元格，只对比这些单元格的新旧值：

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim inputCell As Range
    Dim depCell As Range
    Dim cellKey As String
    Dim oldVal As Variant
    Dim newVal As Variant
    
    ' 记录用户输入
    For Each inputCell In Target
        If Not inputCell.HasFormula Then
            Debug.Print "用户输入：" & Sh.Name & "!" & inputCell.Address & " 值：" & inputCell.Value
            
            ' 查找该单元格的所有跨表从属单元格
            On Error Resume Next
            For Each depCell In inputCell.Dependents
                cellKey = depCell.Parent.Name & "!" & depCell.Address
                oldVal = formulaCache(cellKey)
                newVal = depCell.Value
                
                If oldVal <> newVal Then
                    Debug.Print "从属单元格变化：" & cellKey & " 旧值：" & oldVal & " 新值：" & newVal
                    formulaCache(cellKey) = newVal
                End If
            Next depCell
            On Error GoTo 0
        End If
    Next inputCell
End Sub

关键注意事项 #

• Dependents属性无法追踪间接从属（比如A依赖B，B依赖C，输入C时，A的从属不会被直接捕获），如果需要处理间接依赖，可结合Range.Precedents递归追踪
• 若存在循环引用，Dependents会抛出错误，需用On Error Resume Next捕获
• 隐藏工作表或保护工作表中的从属单元格也会被追踪，需根据实际场景调整权限处理

内容的提问来源于stack exchange，提问作者microsoftboy