vba 随着数据的扩展自动复制公式
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/5498065/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Automatically copy formulas as data expands
提问by SteveW1968
HI all, I have large set of data that is updated twice weekly. The data set shrinks and grows continuosly. My problem is that, although it easy enough for me to manually delete or expand the formulas that make the data usable, i would like to automate the process. The formulas cover 10 columns.
大家好，我有大量数据，每周更新两次。数据集不断缩小和增长。我的问题是，虽然手动删除或扩展使数据可用的公式对我来说很容易，但我想自动化这个过程。公式涵盖 10 列。
OK - Need help, I just cant seem to get my head round Worksheet_change-please help.
好的 - 需要帮助，我似乎无法理解 Worksheet_change-请帮忙。
The worksheet is named "data".
工作表被命名为“数据”。
I am using Col A titled "task no" to base the expansion of the formulas on.
我正在使用名为“task no”的 Col A 来扩展公式。
The formulas are in cols Y to AJ.
公式在列 Y 到 AJ 中。
All i want is the formulas to expand themselves to last entry in row - sounds easy??????
我想要的只是将自己扩展到行中最后一个条目的公式 - 听起来很简单？？？？？？
By data currently cover 30,000 rows,
按目前覆盖 30,000 行的数据，
One other thing, the data is imported into the spreadsheet using a copy and paste macro, is this partly causing my problem?
另一件事是，使用复制和粘贴宏将数据导入电子表格，这是否部分导致了我的问题？
Insert at 13.30
在 13.30 插入
Here is what I have tried
这是我尝试过的
Sheets("data").Select
Bot = Range("A3").End(xlDown).Row
Range("Y30000", "AJ30000").Select
Range("Y30000", "AJ30000").Copy
Selection.AutoFill Destination:=Range("Y30001" & Bot &, ":AJ30001" & Bot),
Type:=xlFillDefault
Please help (Again)
请帮助（再次）
采纳答案by Tiago Cardoso
I can think of two ways of doing it, one directly Excel and another using VBA.
我可以想到两种方法，一种直接使用 Excel，另一种使用 VBA。
Test Scenario:
测试场景：
Let's think we have columns A and B with variable data and then columns C and D with formulas (once you get the login behind the scenes, the amount of columns with formulas won't be important).
假设我们有带有可变数据的 A 列和 B 列，然后是带有公式的 C 列和 D 列（一旦您在后台登录，带有公式的列的数量就不重要了）。
Besides, our formulas in column C are =A+B and in column D =A-B (C1=A1+B1, D1=A1-B1 and so on).
此外，我们在C列中的公式是=A+B，在D列中=AB（C1=A1+B1，D1=A1-B1等等）。
Excel:
电子表格：
- Add into the formulas a test to check if there's any value in column A. If there's no value, we'll not put any information in the cell. Example: C1=IF(LEN(A1)>0,A1+B1,"") / D1 = =IF(LEN(A1)>0,A1-B1,""). Using this formula, you can copy the formula into the whole columns that nothing will be shown in case no data exists.
- Pros:Easy to implement
- Cons:The calculation time can take very long depending on your formulas
- 在公式中添加一个测试以检查 A 列中是否有任何值。如果没有值，我们将不会在单元格中放入任何信息。示例：C1=IF(LEN(A1)>0,A1+B1,"") / D1 = =IF(LEN(A1)>0,A1-B1,"")。使用此公式，您可以将公式复制到整列中，如果不存在数据，则不会显示任何内容。
- 优点：易于实施
- 缺点：根据您的公式，计算时间可能会很长
VBA:
VBA：
- You can implement a routine to update the formulas once the data changes in the sheet by using Worksheet_Change().
- Pros:Requires a minimal VBA knowledge (almost none if a folk here in the SO build for you the code)
- Cons:If you don't know VBA, you may depend on someone else to implement.
- 一旦工作表中的数据发生变化，您可以使用 Worksheet_Change() 实现一个例程来更新公式。
- 优点：需要最少的 VBA 知识（如果 SO 中的人为您构建代码，则几乎不需要）
- 缺点：如果您不了解 VBA，您可能需要依靠其他人来实现。
Hope it guide you to the solution of your problem!
希望它能指导您解决问题！
Edit:
编辑：
The VBA formula to do it would be like this...
做这件事的VBA公式是这样的......
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lCellCount As Long
Dim lFormulaCount As Long
Dim oWorkSheet As Excel.Worksheet
Dim oRangeSource As Excel.Range
Dim oRangeDest As Excel.Range
'Define sheet
Set oWorkSheet = Worksheets("Data")
'Count how many entries we have in our dataset now
lCellCount = oWorkSheet.Range("A1").End(xlDown).Row
'Count how many formulas we have to proper delete
lFormulaCount = WorksheetFunction.CountA(oWorkSheet.Columns("Y"))
If lCellCount <> lFormulaCount Then
'I assume we'll have at least one line in our report...
If lFormulaCount > 2 Then oWorkSheet.Range("Y3:AJ" & lFormulaCount).ClearContents
Set oRangeSource = oWorkSheet.Range("Y2:AJ2")
Set oRangeDest = oWorkSheet.Range("Y2:AJ" & lCellCount)
oRangeDest.Formula = oRangeSource.Formula
End If
End Sub
Rgds
Rgds
回答by tpascale
I think this snippet will help you. It presumes that you give a range name to the hdr cells preceding your data cols and formula cols resepectively (presumably the hdr row would never get deleted). Can be tweaked to handle other schemes for locating the ranges to operate on.
我认为这个片段会对你有所帮助。它假定您分别为数据列和公式列之前的 hdr 单元格指定了范围名称（大概 hdr 行永远不会被删除）。可以调整以处理用于定位要操作的范围的其他方案。
' DA1 = 1st data row, FR1 = first formula row
Dim rgDA1 As Range: Set rgDA1 = Range("HDR_ROW_FOR_DATA").Offset(1)
Dim rgFR1 As Range: Set rgFR1 = Range("HDR_ROW_FOR_FORMULAS").Offset(1)
Dim ws As Worksheet: Set ws = rgDA1.Worksheet
' define range rgDAT to cover ALL data rows, and define rgFRM w the same# rows
Dim rgDAT As Range: Set rgDAT = rgDA1.Resize(1 + ws.Rows.Count - rgDA1.Row)
Set rgDAT = Intersect(rgDAT, ws.UsedRange)
Dim rgFRM As Range: Set rgFRM = rgFR1.Resize(rgDAT.Rows.Count)
' now copy the 1st formula row to the other rows
rgFR1.Select
Selection.Copy
rgFRM.Select
ws.Paste
Application.CutCopyMode = False
