粘贴公式和值更有效地跨越一个范围？

我正在尝试在单元格范围内添加和复制公式，然后粘贴这些值。 目前，我有代码的作品，但运行时间太长。 你知道更有效的方法来实现我的目标吗？ 我在〜3.69分钟的时间里把这个公式粘贴在77000个单元格上。

Application.Calculation = xlCalculationManual Application.ScreenUpdating = False Application.DisplayAlerts = False Application.EnableEvents = False Dim ws As Worksheet, Lastrow As Long Set ws = Sheets("Sheet1") With ws Lastrow = ws.Range("A" & Rows.Count).End(xlUp).Row .Range("CS1").Value = "Actual Bonus - Amount" .Range("CS2").Formula = "=SUMIF(Table7[ID],table3[ID],Table7[Actual])" .Range("CS2").Copy .Range("CS3:CS" & Lastrow).PasteSpecial xlPasteFormulas End With Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True Application.DisplayAlerts = True Application.EnableEvents = True End Sub 

谢谢！

Answer 1

您可以使用.FillDown将公式放入下面的单元格中，而无需复制/粘贴。

 Application.Calculation = xlCalculationManual Application.ScreenUpdating = False Application.DisplayAlerts = False Application.EnableEvents = False Dim ws As Worksheet, Lastrow As Long Set ws = Sheets("Sheet1") With ws Lastrow = ws.Range("A" & Rows.Count).End(xlUp).Row .Range("CS1").Value = "Actual Bonus - Amount" .Range("CS2").Formula = "=SUMIF(Table7[ID],table3[ID],Table7[Actual])" .Range("CS2:CS" & Lastrow).FillDown End With Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True Application.DisplayAlerts = True Application.EnableEvents = True End Sub