我有从不同文件中收集的大量数据。在本主要工作簿中,我为每个单元格设置了不同类型的公式。范围 A 到 F 是收集其他文件的数据的位置。在 H 到 AC 范围内,我有一个公式,每次输入新数据时,我都会通过手动向下拖动来自动填充公式。下面的代码是我使用的,它只有 6 个我想要自动填充的不同公式。
Application.ScreenUpdating = False
lastRow = Range("B" & Rows.Count).End(xlUp).Row
Range("D2").Formula = "=$L$1/$L$2"
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$2+(3*SQRT(($D$2*(1-$D$2))/2116))"
Range("F2").AutoFill Destination:=Range("F2:F" & lastRow)
Range("G2").Formula = "=$D$2-(3*SQRT(($D$2*(1-$D$2))/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
然而,在主工作簿中有大约 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
我把代码弄乱了很多。我什至不知道事情是否应该是这样的。感谢您的帮助!
您正在寻找的方法是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
截图:
截至行结果:.Range("C2:E2").Formula = strFormulas
:
截至行结果:.Range("C2:E11").FillDown
:
当然,您可以通过将最后一行存储到变量中并将其转换为类似的内容来使其动态化.Range("C2:E" & LRow).FillDown
,就像你所做的那样。
希望这可以帮助!
本文内容由网友自发贡献,版权归原作者所有,本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容,请联系:hwhale#tublm.com(使用前将#替换为@)