Vba 在一个范围内更有效地粘贴公式和值？

我试图在一系列单元格中添加和复制公式，然后粘贴值。目前，我的代码可以运行，但运行时间太长。你知道有什么更有效的方法来实现我的目标吗？我在大约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

---

谢谢大家!

您可以使用.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

---

.菲尔顿在约3.31分钟时表现稍好。还有其他想法吗？谢谢。尝试一下上面评论中发布的@Kyle解决方案，看看是否更快。除此之外，我不知道还有其他更有效的方法来添加这么多公式。您可以直接将公式分配给整个范围：

.range（“CS2:CS”&Lastrow）。formula=“=SUMIF（Table7[ID]，table3[ID]，Table7[Actual]）”

如果要在内存中尝试处理SUMIF，您必须提供15-20行样本数据。将公式分配到整个范围的速度较慢。您确定瓶颈不是在计算公式吗？我认为瓶颈是在计算大量行的公式。