更有效地粘贴整个范围的公式和值？

Question

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

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