更有效地粘貼整個範圍的公式和值？

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