Excel VBA：使用公式自动填充多个单元格

Excel VBA: AutoFill Multiple Cells with Formulas

提问by user3233328

I have big amount of data that I collected from different files. In this main workbook, I have different types of formulas for every cells. In range A to F is where the data from other files are collected. In range H to AC, I have the formula that I auto fill by dragging it down manually every time new data is entered. The code below is what I used and it only have 6 different formulas that I want to auto fill.

我从不同的文件中收集了大量数据。在这本主要工作簿中，我为每个单元格设置了不同类型的公式。范围 A 到 F 是收集来自其他文件的数据的位置。在 H 到 AC 的范围内，我有一个公式，每次输入新数据时，我都会通过手动将其向下拖动来自动填充。下面的代码是我使用的，它只有 6 个我想要自动填充的不同公式。

Application.ScreenUpdating = False

lastRow = Range("B" & Rows.Count).End(xlUp).Row
Range("D2").Formula = "=$L/$L"
Range("D2").AutoFill Destination:=Range("D2:D" & lastRow)

Range("E2").Formula = "=$B2/2116"
Range("E2").AutoFill Destination:=Range("E2:E" & lastRow)

Range("F2").Formula = "=$D+(3*SQRT(($D*(1-$D))/2116))"
Range("F2").AutoFill Destination:=Range("F2:F" & lastRow)

Range("G2").Formula = "=$D-(3*SQRT(($D*(1-$D))/2116))"
Range("G2").AutoFill Destination:=Range("G2:G" & lastRow)

Range("H2").Formula = "=IF($E2>=$F2,$E2,NA())"
Range("H2").AutoFill Destination:=Range("H2:H" & lastRow)

Range("I2").Formula = "=IF($E2<=$G2,$E2,NA())"
Range("I2").AutoFill Destination:=Range("I2:I" & lastRow)
ActiveSheet.AutoFilterMode = False

Application.ScreenUpdating = True

However, in the main workbook there is like 15 different formulas that I want it to auto fill every time new data enters. I have multiple main workbook, and the formula is not constant. Inserting the code above for every formula is a pain. Is there a way that can make the program to drag it down automatically? In the main workbook, I have the formulas written out already. I tried many different codes to make it auto fill, but so far the one above is the only one that working without giving me errors. I tried using something like this or similar version to this one, but none is working:

但是，在主工作簿中有 15 个不同的公式，我希望它在每次输入新数据时自动填充。我有多个主要工作簿，公式不是恒定的。为每个公式插入上面的代码是一种痛苦。有什么办法可以让程序自动拖下来？在主要工作簿中，我已经写出了公式。我尝试了许多不同的代码来使其自动填充，但到目前为止，上面的代码是唯一一种不会出错的代码。我尝试使用类似这个或类似版本的东西，但没有一个工作：

With wbList.Sheets("Attribute - 10 mil stop")
    lastRow = Worksheets(ActiveSheet.Name).Range("B2").Rows.Count
    'Worksheets(ActiveSheet.Name).Range(Selection, Selection.End(xlDown)).Select
    Worksheets(ActiveSheet.Name).Range("D2:I2").Select
    Selection.AutoFill Destination:=Range("D2:I" & Range("B2" & Rows.Count).End(xlDown).Row)
End With

I messed around with the code so much. I don't even know if it's suppose to be like that. Thank you for helping!

我把代码弄乱了很多。我什至不知道它是否应该是这样的。感谢您的帮助！

回答by Jerome Montino

The approach you're looking for is FillDown. Another way so you don't have to kick your head off every time is to store formulas in an array of strings. Combining them gives you a powerful method of inputting formulas by the multitude. Code follows:

您正在寻找的方法是FillDown. 另一种让您不必每次都头疼的方法是将公式存储在字符串数组中。将它们结合起来为您提供了一种强大的方法来输入大量公式。代码如下：

Sub FillDown()

    Dim strFormulas(1 To 3) As Variant

    With ThisWorkbook.Sheets("Sheet1")
        strFormulas(1) = "=SUM(A2:B2)"
        strFormulas(2) = "=PRODUCT(A2:B2)"
        strFormulas(3) = "=A2/B2"

        .Range("C2:E2").Formula = strFormulas
        .Range("C2:E11").FillDown
    End With

End Sub

Screenshots:

截图：

Result as of line: .Range("C2:E2").Formula = strFormulas:

结果截至行.Range("C2:E2").Formula = strFormulas：：

Result as of line: .Range("C2:E11").FillDown:

结果截至行.Range("C2:E11").FillDown：：

Of course, you can make it dynamic by storing the last row into a variable and turning it to something like .Range("C2:E" & LRow).FillDown, much like what you did.

当然，您可以通过将最后一行存储到变量中并将其转换为类似于 的内容来使其动态化.Range("C2:E" & LRow).FillDown，就像您所做的那样。

Hope this helps!

希望这可以帮助！

回答by user2140261

Based on my Comment here is one way to get what you want done:

根据我的评论，这是完成您想要完成的工作的一种方法：

Start byt selecting any cell in your range and Press Ctrl+ T

首先选择范围内的任何单元格，然后按Ctrl+T

This will give you this pop up:

这会给你这个弹出窗口：

make sure the Where is your table text is correct and click ok you will now have:

确保您的表格文本在哪里正确，然后单击确定，您现在将拥有：

Now If you add a column header in D it will automatically be added to the table all the way to the last row:

现在，如果您在 D 中添加列标题，它将自动添加到表格中，一直到最后一行：

Now If you enter a formula into this column:

现在，如果您在此列中输入公式：

After you enter it, the formula will be auto filled all the way to last row:

输入后，公式将自动填充到最后一行：

Now if you add a new row at the next row under your table:

现在，如果您在表格下的下一行添加新行：

Once entered it will be resized to the width of your table and all columns with formulas will be added also:

输入后，它将被调整为表格的宽度，并且所有带有公式的列也将被添加：

Hope this solves your problem!

希望这能解决您的问题！