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

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

1 个答案: