是否可以使用 VBA 从活动单元格向下复制公式

Question

我想实现一个 VBA 代码来处理多个不同的工作表，例如：它首先在第一行中查找某个数字，一旦找到，它会跳转到该列并在第二行中键入某个公式该列中的单元格，到目前为止它运行良好，但问题是如果该行中的第一个单元格包含数据，我想让它自动填充该列的公式。

如果 A2 不为空，则继续自动填充活动列中的单元格（假设活动列是 D，如果 a2 不为空，它将填充单元格 d2）并在 A 列中的单元格停止是空白..等

那么，有可能吗？

Sub Macro1()

Rows("1:1").Select
Selection.Find(What:="156", After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=True, SearchFormat:=False).Activate

ActiveCell.Offset(1).Select
ActiveCell.FormulaR1C1 = _
    "= "Formula will be here""

结束子

Answer 1

在运行以下代码之前最好保存一份工作簿副本。

也许这就是你所追求的。如果Find 在D 列中找到了一些东西，那么它将虚拟公式放在D2:D? 范围内，其中? 是A 列中的最后一行（我认为这是你所描述的）。

Option Explicit

Sub Macro1()

    Dim ws As Worksheet
    Set ws = ActiveSheet ' Can you refer to the workbook and worksheet by name? Please do if possible

    With ws
        Dim cellFound As Range
        Set cellFound = .Rows(1).Find(What:="156", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False)

        If cellFound Is Nothing Then
            MsgBox ("The value was not found in the first row of sheet '" & ws.Name & "'. Code will stop running now")
            Exit Sub
        End If

        Dim lastRow As Long
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        .Range(cellFound.Offset(1), .Cells(lastRow, cellFound.Column)).FormulaR1C1 = "=""Formula will be here"""
    End With
End Sub

Answer 2

检查这个简单的代码，我想它会满足你的需求：

Sub Macro1()


Rows("1:1").Select
Selection.Find(What:="156", After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=True, SearchFormat:=False).Activate

    col_Num = ActiveCell.Column
    total_Rows = WorksheetFunction.CountA(Range("A:A"))
    Cells(2, col_Num).Select
    Cells(2, col_Num) = "=Put your Formula here"
    begin_Cell = Cells(2, col_Num).Address(False, False)
    end_Cell = Cells(total_Rows, col_Num).Address(False, False)
    Selection.AutoFill Destination:=Range(begin_Cell & ":" & end_Cell)

End Sub

Answer 3

虽然我不清楚您为什么使用 LookAt:=xlPart 参数，但有一些更简单的方法可以找到列标题标签。在我看来，您不应该使用“通配符”搜索，但可以使用“通配符”搜索。

Sub FindnFill()

    dim m as variant

    with worksheets("sheet1")

        m = application.match("*156*", .rows(1), 0)
        if not iserror(m) then

            if not isempty(.cells(2, "A")) then
                .range(.cells(2, m), .cells(.rows.count, "A").end(xlup).offset(0, m-1)).formula = _
                   "=""formula goes here"""
            else
                .cells(2, m).formula = _
                   "=""formula goes here"""
            end if

        end if

    end with

end sub

Answer 4

查找和填写

关于查找方法

• 最好始终设置以下三个参数，因为它们 每次使用时都会保存。
• LookIn - 如果您使用xlFormulas，它将找到例如=A2 + 156，你不想要。
• LookAt - 如果您使用 xlPart，它将找到例如1567，你不想要。
• SearchOrder - 不重要，因为正在搜索一行。
• 此外，SearchDirection 是 默认 xlNext，因此可以安全地省略。
• 此外，MatchCase 是 默认 False，因此可以安全地省略。
• 另外还有 SearchFormat - 要使用它，您之前必须设置 Application.FindFormat.NumberFormat，因此可以安全地省略。

代码

Sub FindFill()

  Const cDblFind As Double = 156             ' Found Value
  Const cLngRow As Long = 1                  ' Found Row Number
  Const cVntColumn As Variant = "A"          ' First Column Letter/Number
  Const cStrFormula As String = "=RC[-1]+5"  ' Formula

  Dim objFound As Range   ' Found Column Cell Range
  Dim lngRow As Long      ' First Column Non-empty Rows

  With ActiveSheet.Rows(cLngRow)

    ' Check if cell below cell in First Column and Found Row is empty.
    If .Parent.Cells(cLngRow, cVntColumn).Offset(1, 0).Value = "" Then Exit Sub

    ' Calculate First Column Non-empty Rows.
    lngRow = .Parent.Cells(cLngRow, cVntColumn).End(xlDown).Row - cLngRow

    ' Find cell in Found Row containing Found Value.
    Set objFound = .Find(What:=cDblFind, After:=.Cells(.Row, .Columns.Count), _
        LookIn:=xlValues, LookAt:=xlWhole, Searchorder:=xlByRows)

    If Not objFound Is Nothing Then
      ' Write Formula to Found Column Range
      objFound.Offset(1, 0).Resize(lngRow).FormulaR1C1 = cStrFormula
    End If

  End With

End Sub