Question

我有一个公式，每次执行时都会发出API请求，这很慢。我想防止Excel自动重新计算包含此公式的单元格，但仍然自动重新计算其他单元格。

我尝试通过以下方式将计算模式设置为“手动”：

Application.Calculation = xlCalculationManual

但是，这会阻止没有我的公式的其他单元格自动计算。

我的另一个想法是检查某个单元格是否已经“冻结”，然后返回其当前值，而不是调用API以获得新值。问题在于Excel无法提供一种不更改单元格值而退出函数的方法。

Function MyFormula() As Variant

   If CellIsFrozen() Then
       MyFormula = Application.Caller.Value  'return current value
   Else
       MyFormula = GetNewValueFromAPI()  'expensive call to server
   End If

End Function

我的上述问题是Application.Caller.Value通过执行重新计算返回单元格值并导致无限递归。

仅供参考-CellIsFrozen方法只是一个示例子，它将以某种方式检查是自动还是手动调用了该单元格。

我也知道Application.Caller.Value2和.text，不幸的是这些对我没有帮助。 Value2也会导致重新计算，而text仅返回字符串表示形式（这没有用，因为如果值是日期并且列太窄，则可能是“ ######” ）。

有没有一种方法可以中断Excel对特定公式的重新计算过程？

否则，有可能在不执行重新计算的情况下提取单元格的值-我猜测Excel会将值存储在某个地方，因为它在工作表上可见，因此每次都坚持重新计算是没有道理的。

Answer 1

在我之前对单个单元的帖子的回答中，我也想分享我们涉及多个单元的旧经验。那时，我们以=myformula(1)...等索引方式使用该公式，并将其存储在全局数组中。现在，感谢您对Caller函数的好主意。我重新创建了一个涉及多个单元的简易解决方案。

再次在模块1中

Global Flag As Boolean, LastValArr(1 To 10, 1 To 2) As Variant, Ws As Worksheet, Rng As Range

Public Function MyFormula() As Variant
Dim Adr As String, X As Integer
   If Flag Then
   MyFormula = GetNewValueFromAPI()  'expensive call to server
   Else
   Adr = Application.Caller.Address
    For X = 1 To 10
        If InStr(1, LastValArr(X, 2), Adr) > 0 Then
        MyFormula = LastValArr(X, 1)
        Exit For
        End If
    Next
   End If
End Function

Function GetNewValueFromAPI() As Variant
GetNewValueFromAPI = Application.WorksheetFunction.RandBetween(1, 1000)
End Function

Sub CalcA1()
Flag = True
Rng.Dirty
Flag = False
Ws.Range("F1").Value = IIf(Flag, "On", "Off")
End Sub

Sub ToggleFlag()
Flag = Not Flag
Ws.Range("F1").Value = IIf(Flag, "On", "Off")
If Flag Then Rng.Dirty
End Sub

在Workbook_Open事件中

Private Sub Workbook_Open()
Dim X As Integer
Dim Cell As Range
Set Ws = ThisWorkbook.Sheets("Sheet1")
Set Rng = Ws.Range("A1:A5")
Set Rng = Union(Rng, Ws.Range("C1:C5"))
Flag = True
Rng.Dirty
Flag = False
Ws.Range("F1").Value = IIf(Flag, "On", "Off")
End Sub

在Sheet1 Worksheet_Calculate事件中

Private Sub Worksheet_Calculate()
Dim X As Integer
Dim Cell As Range
X = 1
    For Each Cell In Rng.Cells
    LastValArr(X, 1) = Cell.Value
    LastValArr(X, 2) = Cell.Address
    X = X + 1
    Next
End Sub

编辑：在最初感觉好发布演示答案后的第二个想法，我发现它缺乏用户友好性，并且在Excel中工作时缺乏粘贴UDF公式的复制容易性，因此我尝试进一步即兴创作可以被无法访问VBA代码的用户使用，并且可以与UDF的复制粘贴一起使用。

因此，我首先遇到了一个解决方案，用于将最后值存储在临时表中（可能是非常隐藏的表）。由于担心使用单元格访问可能会降低代码的性能，因此我避免发布代码，最终恢复为Dictionary Object。

此解决方案具有自动映射公式单元格的基本优点（通过在工作表的使用范围内搜索"=myformula"）来启用/禁用计算。这样一来，无需访问代码模块的用户就可以自由地使用UDF。

已添加对Microsoft脚本运行时的引用。

模块中的代码：

Global Flag As Boolean, Ws As Worksheet, Rng As Range, Dict As Dictionary
Public Function MyFormula() As Variant
Dim Adr As String
   If Flag Then
   MyFormula = GetNewValueFromAPI() 'expensive call to server
   Else
   Adr = Application.Caller.Address
   'Debug.Print Adr
   MyFormula = IIf(Dict.Exists(Adr), Dict(Adr), 0)
   End If
End Function
Function GetNewValueFromAPI() As Variant
'Delay (2)
GetNewValueFromAPI = Application.WorksheetFunction.RandBetween(1, 1000)
End Function
Sub CalcA1()
Flag = True
If Not Rng Is Nothing Then Rng.Dirty
'Debug.Print "in calA1"
Flag = False
Ws.Range("F1").Value = IIf(Flag, "On", "Off")
End Sub
Sub ToggleFlag()
Flag = Not Flag
Ws.Range("F1").Value = IIf(Flag, "On", "Off")
If Flag And Not Rng Is Nothing Then Rng.Dirty
End Sub
Sub BuildRange()
Application.EnableEvents = False
Dim Cell As Range
CalcCnt = CalcCnt + 1
    Set Rng = Nothing
    Dict.RemoveAll
    For Each Cell In Ws.UsedRange.Cells
        If Left(Cell.Formula, 10) = "=myformula" Then
        'Debug.Print "From Sht Calc -" & Cell.Address
            If Dict.Exists(Cell.Address) = False Then
            Dict.Add Cell.Address, Cell.Value
            Else
            Dict(Cell.Address) = Cell.Value
            End If

            If Rng Is Nothing Then
            Set Rng = Cell
            Else
            Set Rng = Union(Rng, Cell)
            End If
        End If
    Next

Application.EnableEvents = True
End Sub

在工作簿中打开

Private Sub Workbook_Open()
'Dim X As Integer
Dim Cell As Range
Set Ws = ThisWorkbook.Sheets("Sheet1")
Set Dict = New Dictionary
Flag = True
BuildRange
If Not Rng Is Nothing Then Rng.Dirty
Flag = False
Ws.Range("F1").Value = IIf(Flag, "On", "Off")
End Sub

在工作表中计算事件

私人子Worksheet_Calculate（）生成范围结束

Answer 2

如果您在单元格中使用UDF，那么我将采用这种解决方法。为了进行演示和测试，我只在“ Sheet1”中使用了一个单元格A1，而不使用任何API，而是使用WorksheetFunction.RandomBetween。如果使用了多个单元格，则可以使用范围和数组。

在“ Sheet1”单元格A1中使用了=myFormula()

在模块中

Public Flag As Boolean, LastVal As Variant

Public Function MyFormula() As Variant
   If Flag Then
   MyFormula = GetNewValueFromAPI()  'expensive call to server
   Else
   MyFormula = LastVal
   End If
End Function

Function GetNewValueFromAPI() As Variant
GetNewValueFromAPI = Application.WorksheetFunction.RandBetween(1, 1000)
End Function

CalcA1中的

Sub Module1将在必要时用于重新计算A1。也可以根据实际需要从任何事件中调用它。

Sub CalcA1()
Flag = True
Worksheets("Sheet1").Range("A1").Dirty
Flag = False
End Sub

在工作簿打开事件中，LastVal的计算将Flag设置为true，然后将Flag重置为false以防止进一步调用GetNewValueFromAPI

Private Sub Workbook_Open()
Flag = True
Worksheets("Sheet1").Range("A1").Dirty
LastVal = Worksheets("Sheet1").Range("A1").Value
Flag = False
End Sub

在Sheet1的Worksheet_Calculate事件中，正在记录LastVal。

Private Sub Worksheet_Calculate()
LastVal = Worksheets("Sheet1").Range("A1").Value
End Sub

工作演示

遗憾，我很晚才遇到此帖子（一个真正的好问题），因为我们已经在工作场所的此行中使用过某些东西。感谢@Pawel Czyz编辑帖子，仅在今天将其列入活动列表。

是否可以为特定公式启用Excel手动计算？

2 个答案: