Можно ли использовать VBA для создания условной копии формулы из активной ячейки вниз по столбцу

Question

Я хочу реализовать код VBA для работы с несколькими различными листами, например: он начинается с поиска определенного числа в первой строке, когда он найден, он переходит к этому столбцу и вводит определенную формулу во 2-йячейка в этом столбце, пока она работает хорошо, но проблема в том, что я хочу сделать это для автозаполнения этой формулы вниз по столбцу, если первая ячейка в этой строке содержит данные.

Например, если A2 не пусто,продолжить автоматическое заполнение ячейки в активном столбце (скажем, активный столбец - D, затем он заполнит ячейку d2, если a2 не пусто) и остановится, когда ячейка в столбце A станет пустой .. etc

Итак, это возможно?

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""

End Sub

Answer 1

Найти и заполнить

О методе поиска

• Рекомендуется всегда устанавливать следующие три параметра, поскольку они сохраняются при каждом использовании.
• 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

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

Лучше всего сохранить копию своей рабочей книги перед запуском приведенного ниже кода.

Возможно, вам нужно что-то вроде этого.Если 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