随着数据扩展自动复制公式

Question

大家好，我有大量数据，每周更新两次。数据集不断缩小和增长。 我的问题是，虽然手动删除或扩展使数据可用的公式对我来说很容易，但我想自动化该过程。 这些公式涵盖 10 列。

好的 - 需要帮助，我似乎无法理解 Worksheet_change - 请帮助。

该工作表名为“数据”。

我使用标题为“任务号”的 A 栏作为公式展开的基础。

公式位于 Y 至 AJ 列中。

我想要的只是将公式扩展到行中的最后一个条目 - 听起来很简单??????

目前数据覆盖 30,000 行，

另一件事是，使用复制和粘贴宏将数据导入到电子表格中，这是否是导致我的问题的部分原因？

在 13.30 插入

这是我尝试过的

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

请帮忙（再次）

Answer 1

我可以想到两种方法，一种是直接使用 Excel，另一种是使用 VBA。

测试场景：

假设我们有包含变量数据的 A 列和 B 列，以及包含公式的 C 列和 D 列（一旦您在后台登录，包含公式的列的数量就不重要了）。

此外，C 列中的公式为 =A+B，D 列中的公式为 =AB（C1=A1+B1、D1=A1-B1 等）。

Excel：

• 在公式中添加一个测试，检查 A 列中是否有任何值。如果没有值，我们不会在单元格中放入任何信息。示例：C1=IF(LEN(A1)>0,A1+B1,"")/D1 = =IF(LEN(A1)>0,A1-B1,"")。使用此公式，您可以将公式复制到整个列中，如果不存在数据，则不会显示任何内容。
  • 优点：易于实施
  • 缺点：计算时间可能会花费很长的时间，具体取决于您的公式

VBA：

• 您可以实现一个例程一旦工作表中的数据发生更改，就可以使用 Worksheet_Change() 更新公式。
  • 优点：需要最低限度的 VBA 知识（如果 SO 中的人员为您构建代码，则几乎不需要）
  • 缺点：如果您不懂 VBA，您可能需要依赖其他人来实现。

希望它能指导您解决问题！

编辑：

执行此操作的 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

Answer 2

我认为这个片段会对您有所帮助。它假定您分别为数据列和公式列之前的 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