使用宏在列表底部的特定列中添加几个公式

Question

我想要实现的目标如下：

1. 在细胞G2，H2和＆amp;中插入公式（公式＃1，＃2和＃3）。 J2。
2. 复制这些公式（插入单元格G2，H2和J2）并将其向下拖动到表格的底部。



一些有用的信息： - 行数是动态的。这意味着每月，它会发生变化。历史上最小行数为60,000行。 - 人员姓名下b至F栏的金额也会发生变化。有时，它是空白的（就像在我的例子中一样）。

我使用excel宏录制器编码一个宏，但它失败了它非常慢。在完成100,000行之前20分钟。这有更快的代码吗？是否有人可以帮助我如何：

1. 插入以G，H和J列开头的以下公式。
2. 将该公式复制到列表底部然后停止？

可能吗？

这是我的代码：

Sub Formula()

    Dim rng As Range
    Dim i As Long


    Set rng = Range("A2:A1048576")
    For Each cell In rng
        'test if cell is empty
        If cell.Value <> "" Then

            cell.Offset(0, 6).FormulaR1C1 = "=AVERAGE(RC[-6]:RC[-2])"
            cell.Offset(0, 7).FormulaR1C1 = "=SUM(RC[-5]:RC[-1])*0.5"
            cell.Offset(0, 8).FormulaR1C1 = "=CONCATENATE(RC[-9],RC[-8],RC[-7],RC[-6],RC[-5],RC[-4])"
        End If
    Next

End Sub

Answer 1

我敢打赌这很快：

Public Sub DC1(ws As Worksheet)
  Dim lastrow&, rng1 As Range, rng2 As Range
  lastrow = ws.Cells(Rows.Count, 1).End(xlUp).Row
  Set rng1 = ws.Range("A2:A" & lastrow).SpecialCells(xlCellTypeConstants)
  Set rng2 = rng1.Offset(0, 6)
  rng2.Formula = "=AVERAGE(RC[-6]:RC[-2])"
  Set rng2 = rng1.Offset(0, 7)
  rng2.Formula = "=SUM(RC[-5]:RC[-1])*0.5"
  Set rng2 = rng1.Offset(0, 9)
  rng2.Formula = "=CONCATENATE(RC[-9],RC[-8],RC[-7],RC[-6],RC[-5],RC[-4])"
End Sub

编辑：添加了lastrow
EDIT2：添加了ws参数; .Formula而不是.Value。
没有ws参数，它默认为ActiveSheet。 如果从工作表调用，则Sub DC1必须位于标准模块中。

Answer 2

Excel会评估它设置的每个新公式 - 这就是为什么代码需要很长时间才能完成的原因。要解决这个问题，您可以立即设置整个范围的公式 - 假设公式是可复制的。

例如，Sheets("Sheet1").Range("G2:G100000").Formula = "=SUM(B2:F2)*.50"工作得很好， G3 会有一个公式=SUM(B3:F3)*.50，依此类推。