复制公式或填充下来

我使用vba从多个单元格复制公式并粘贴到大量的单元格。 这是我的代码 –

Sub FillFormulae() Application.ScreenUpdating = False Dim WS As Worksheet: WS = Sheets("Main") WS.Range("E15:P15").Copy WS.Range("E16:P" & MainDataLastCell).PasteSpecial xlPasteFormulas WS.Range("S15:EA15").Copy WS.Range("S16:EA" & MainDataLastCell).PasteSpecial xlPasteFormulas End Sub 

MainDataLastCell是一个全局variables，其当前数据的值为312896。 这可以根据数据更多或更less。

问题是这个代码需要4个多小时才能完成。 你们认为如果我使用“Filldown”而不是复制公式，它会花费更less的时间？

Answer 1

build议您尝试

1. closures计算
2. closuresscreenupdating

下面的代码也修复了编译错误，因为WS = Sheets("Main")将不起作用

 Const MainDataLastCell = 312896 Sub FillFormulae() Application.ScreenUpdating = False Dim WS As Worksheet Dim lngCalc As Long Set WS = Sheets("Main") With Application lngCalc = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False End With With WS .Range("E16:P" & MainDataLastCell).FormulaR1C1 = .Range("E15:P15").FormulaR1C1 .Range("S16:EA" & MainDataLastCell).FormulaR1C1 = .Range("S15:EA16").FormulaR1C1 End With With Application .Calculation = lngCalc .ScreenUpdating = True End With End Sub 

Answer 2

下面怎么样？ 用一个简单的公式，这只需要大约一分钟在我的机器上运行。

 Sub fillformulae() Application.ScreenUpdating = False Dim icol As Integer Dim irow As Integer Dim WS As Worksheet: WS = Sheets("Main") For icol = 5 To 16 WS.Range(Cells(16, icol), Cells(MainDataLastCell, icol)).Formula = WS.Cells(15, icol).Formula Next For icol = 19 To 131 WS.Range(Cells(16, icol), Cells(MainDataLastCell, icol)).Formula = WS.Cells(15, icol).Formula Next Application.ScreenUpdating = True End Sub