Можно ли включить ручное вычисление Excel для определенных формул?

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

Редактировать: Подумав, после первоначального приятного ощущения от публикации демо-ответа, я обнаружил, что ему не хватает удобства для пользователя и простоты копирования при вставке формул UDF при работе в Excel. Поэтому я попытался импровизировать дальше, чтобы он мог использоваться пользователями, не имеющими доступа к коду VBA, и может работать с копировальной пастой UDF.

Итак, во-первых, я натолкнулся на решение сохранить последние значения в временном листе (может быть, очень скрытый лист). с опасением, что работа с доступом к ячейке может ухудшить производительность кода, я воздержался от публикации и наконец восстановил объект Dictionary.

В это решение добавлено базовое преимущество автоматического сопоставления ячеек формулы (путем поиска "=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

In Workbook_Open

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

Событие In Sheet Calculate

Private Sub Worksheet_Calculate () BuildRange End Sub

Answer 2

Если вы используете UDF в ячейке, я хотел бы сделать это как обходной путь.Для демонстрации и тестирования использовалась только одна ячейка A1 в «Sheet1», вместо использования какого-либо API, я использовал WorksheetFunction.RandomBetween Может использовать диапазон и массив, если используется несколько ячеек.

В ячейке A1 «Sheet1»используется =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

Sub CalcA1 в Module1 будет использоваться для пересчета A1 при необходимости.Его можно вызывать из любых событий, также в соответствии с фактическим требованием.

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

В событии Open рабочей книги значение LastVal было рассчитано с флагом как истинным, а затем флаг был сброшен на ложное значение для предотвращения дальнейшего вызова GetNewValueFromAPI

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

В событии Worksheet_Calculate для Sheet1 записывается LastVal.

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

Рабочая демонстрация

СожалениеЯ наткнулся на этот пост (A Real Good Question) поздно, так как мы уже использовали что-то в этой строке на нашем рабочем месте.Спасибо @Pawel Czyz за редактирование поста, который только сегодня попал в Active List.