公式计算太慢

Question

我想编写一个 Excel 宏：我有一些计算的起始值。有超过 100 个不同的起始数字，我想自动复制右侧单元格中的起始值，其他一些单元格具有读取该值并使用它的公式。这些公式正在从网络上获取一些数据（afaik），在其他一些表格中进行计算，并且需要几秒钟的时间来计算。我正在工作的工作表中的单元格只是链接到其他工作表中的其他单元格，因此公式不直接在“工作表”（工作表＃1）中。我不知道这些公式到底是做什么的，它们不是我的。 对于每个起始数字，我想将结果复制到另一张表中。

Private Sub CommandButton1_Click()
Application.Calculation = xlCalculationManual

For i = 2 To Sheets(2).Range("A1048576").End(xlUp).Row
    Sheets(1).Cells(5, 3).Value = Sheets(2).Cells(i, 3).Value

    Application.CalculateFull

    Sheets(2).Cells(i, 4).Value = Sheets(1).Cells(7, 3).Value
    Sheets(2).Cells(i, 5).Value = Sheets(1).Cells(8, 3).Value
    Sheets(2).Cells(i, 6).Value = Sheets(1).Cells(9, 3).Value
    Sheets(2).Cells(i, 7).Value = Sheets(1).Cells(10, 3).Value
    Sheets(2).Cells(i, 8).Value = Sheets(1).Cells(11, 3).Value
    Sheets(2).Cells(i, 9).Value = Sheets(1).Cells(12, 3).Value
    Sheets(2).Cells(i, 10).Value = Sheets(1).Cells(15, 3).Value
    Sheets(2).Cells(i, 11).Value = Sheets(1).Cells(16, 3).Value
Next i

Application.Calculation = xlCalculationAutomatic

i = 0
End Sub

所以我从工作表 (2) 中将起始编号（C 列）复制到工作表 (1) 的单元格 (C5) 中。当 Sheet(1) 中的 Cell(C5) 的值发生更改时，Sheet(1).Range(C7:C16) 中的值将被重新计算。 我将新计算的值复制回 Sheet(2)，然后复制到正确起始编号的行中。所以 Sheet(1).Range(C7:C16) （两个值除外）在 Sheet(2).Range(Di:Ki) （i，起始编号的索引）。 这会为每个起始编号循环。

所以 Range(C7:C16) 保存了结果。我的问题是，宏不会等待计算完成。范围内的所有单元格（Di:Ki）都获得相同的值（范围内的值（C7:C16）之前我启动宏）。

我尝试了不同的方式，如 Application.CalculateFull 和

 Do Until Application.CalculationState = xlDone
        DoEvents
    Loop

还有一个 Worksheet_Calculate() 子。我也试过 Worksheet_Change() 但它没有获取公式计算。

当我使用基本加法等简单公式时，它确实有效： 例如。 Sheet(1).C7 的公式为 C5+1（起始编号+1），我将进入 Sheet(2)

Starting Number - Result from Sheet(1).C7
1 - 2
2 - 3
3 - 4 

也许有人可以帮助我？提前致谢！

Answer 1

如果我正确理解您的问题，那么我相信以下内容会达到您的预期，它将从 C 列中的 Sheets(2) 中获取值，并将该值传递给 Sheets(1) 单元格 C5，这将使您的公式进行一些计算，然后它将从 C7:C16 中获取值并将它们放入 Sheets(2) 中的 D 到 M 列中的同一行中，它从以下位置获取初始值：

Private Sub CommandButton1_Click()
Dim i As Long
Application.Calculation = xlCalculationAutomatic
    For i = 2 To Sheets(2).Cells(Sheets(2).Rows.Count, "A").End(xlUp).Row
    'loop from row 2 to last on Sheets(2)
        Sheets(1).Cells(5, 3).Value = Sheets(2).Cells(i, 3).Value
        'add value from column C Sheets(2) to C5 of Sheets(1) for the formula calculations to take place
        Sheets(2).Cells(i, 4).Value = Sheets(1).Range("C7").Value
        'get the value from C7 and pass it to the relevant row in Sheets(2) on column D
        Sheets(2).Cells(i, 5).Value = Sheets(1).Range("C8").Value
        'get the value from C8 and pass it to the relevant row in Sheets(2) on column E
        Sheets(2).Cells(i, 6).Value = Sheets(1).Range("C9").Value
        'get the value from C9 and pass it to the relevant row in Sheets(2) on column F, and etc below
        Sheets(2).Cells(i, 7).Value = Sheets(1).Range("C10").Value
        Sheets(2).Cells(i, 8).Value = Sheets(1).Range("C11").Value
        Sheets(2).Cells(i, 9).Value = Sheets(1).Range("C12").Value
        Sheets(2).Cells(i, 10).Value = Sheets(1).Range("C13").Value
        Sheets(2).Cells(i, 11).Value = Sheets(1).Range("C14").Value
        Sheets(2).Cells(i, 12).Value = Sheets(1).Range("C15").Value
        Sheets(2).Cells(i, 13).Value = Sheets(1).Range("C16").Value
    Next i
End Sub

注意：

我删除了 Application.Calculation = xlCalculationManual 行，因为这会导致您的公式在您将其更改回 Application.Calculation = xlCalculationAutomatic 之前不会计算任何内容。如果这不起作用，那么可能值得研究实际公式的作用，因为我已经对此进行了测试，并且它可以满足您的期望。

Answer 2

尝试用这些花哨的技巧强制屏幕更新

• ActiveSheet.Calculate
• ActiveWindow.SmallScroll
• Application.WindowState = Application.WindowState

借自

Force a screen update in Excel VBA