直到最后一行填写公式

我有下面的VBA代码放在单元格AE3的公式，然后复制到最后一行，我有5000 +行，但不知道为什么需要这么长的时间来处理（约5分钟，仍然运行），有没有更好的方式来做这个？ 我想复制到最后一行，因为列表是每天有不同范围的dynamic数据。 谢谢。

Sub FillRows() Dim col_AE As String Sheet1.Select col_AE = "=IFERROR(INDEX(setting!C[-17],MATCH(smart!RC[-9],setting!C[-18],0)),"""")" If col_AE <> vbNullString Then For j = 3 To Range("A" & Rows.Count).End(xlUp).Row - 1 If Range("ae" & j).Value = vbNullString Then Range("ae" & j).Value = col_AE End If Next j End If End Sub 

Answer 1

处理大量公式时，应closuresScreenUpdating和Calculations。

这行If col_AE <> vbNullString Then没有做任何事情。

选项显式

 Sub FillRows() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Dim col_AE As String With Sheet1 For j = 3 To .Range("A" & .Rows.Count).End(xlUp).Row - 1 If .Range("ae" & j).Value = vbNullString Then .Range("ae" & j).FormulaR1C1 = "=IFERROR(INDEX(setting!C[-17],MATCH(smart!RC[-9],setting!C[-18],0)),"""")" End If Next j End With Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub 

---

大部分处理时间正在使用，因为每次添加公式时都会重新计算表格。 我只想closuresScreenUpdating和Calculations并replace所有的公式。 这样我就知道公式是一致的，用户引入的任何错误都会被纠正。

 Sub FillRows2() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Dim col_AE As String With Sheet1 .Range("A3", "A" & .Rows.Count).End(xlUp).FormulaR1C1 = "=IFERROR(INDEX(setting!C[-17],MATCH(smart!RC[-9],setting!C[-18],0)),"""")" End With Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub 

Answer 2

这可能会加快速度 – closures正在运行的屏幕更新。

 Application.ScreenUpdating = False Application.ScreenUpdating = True 

Answer 3

请试试这个：

  Option Explicit Sub fillFormula() Dim wbk1 As Workbook Dim lastRow As Long Set wbk1 = ActiveWorkbook With wbk1.Sheets("sheet1") lastRow = .Range("A" & .Rows.Count).End(xlUp).Row lastRow = lastRow - 1 .Range("AE3:AE" & lastRow).Formula = _ "=IFERROR(INDEX(setting!C[-17],MATCH(smart!RC[-9]," _ & "setting!C[-18],0)),"""")" End With End Sub