Формула применяется к определенным строкам

Question

Я работаю над макросом, который был ранее написан старым сотрудником. Я новый пользователь VBA, поэтому я не разбираюсь в том, как правильно это делать.

Мне нужна формула, чтобы она не применялась к строкам, где присутствует "IBK". Сейчас он применяется к каждой строке.

Я пытался просто переписать и отфильтровать различные критерии и применить формулу таким образом, однако макрос не будет работать

это формула

Columns("Q:Q").Select
Selection.Clear
Range("Q1").Select
ActiveCell.FormulaR1C1 = "New Savings"
Range("Q2").Select
ActiveCell.Formula = "=P2-(7/D2)"
Selection.AutoFill Destination:=Range("Q2:Q" & Range("A" & 
Rows.Count).End(xlUp).Row)
Range("Q2")

Прикрепленное изображение является примером данных. Я, очевидно, работаю с гораздо большим количеством данных, чем это. Мне нужно знать формулу, чтобы не вычитать 7 из ИБК через макрос. Таким образом, сумма IBK составила бы 50 вместо 43.

Изображение :

Answer 1

Прочитайте комментарии и настройте параметры

Sub ApplyFormula()

    Dim evalSheet As Worksheet
    Dim formulaRange As Range

    Dim worksheetName As String
    Dim colEval As String
    Dim colFormula As String
    Dim formulaText As String
    Dim colNumber As Integer
    Dim firstRow As Byte
    Dim lastRow As Long

    ' 1) Set some parameters

        ' Define name of sheet where formulas are going to be added
        worksheetName = "sheet1"
        Set evalSheet = ThisWorkbook.Worksheets(worksheetName)
        'Set evalSheet = Sheet1 ' -> This could come from VBA Editor and replace the previous two lines. It's safer if you use the sheet vba codename see https://stackoverflow.com/questions/41477794/refer-to-sheet-using-codename

        ' Define the column letter where Managed Type is localted
        colEval = "A"
        ' Define the column letter where Formulas should be added (New savings)
        colFormula = "D"
        ' Define where evaluated range begins
        firstRow = 2
        ' Define formula text. text between [] will be replaced
        formulaText = "=IF([colEval][firstRow] = 'IBK', P[firstRow], P[firstRow] - (7 / D[firstRow]))"


    ' 2) Adjust stuff and add the formulas

        ' Adjust the formula to replace the single quotes with doubles
        formulaText = Replace(formulaText, "'", """")
        formulaText = Replace(formulaText, "[colEval]", colEval)
        formulaText = Replace(formulaText, "[firstRow]", firstRow)

        ' Get the column number from the column letter
        colNumber = Columns(colEval).Column

        ' Get the last row with data in column evaluated
        lastRow = evalSheet.Cells(evalSheet.Rows.Count, colNumber).End(xlUp).Row

        ' Set the range to be evaluated
        Set formulaRange = evalSheet.Range(colFormula & firstRow & ":" & colFormula & lastRow)

        ' Add the formulas
        formulaRange.Formula = formulaText

End Sub

Answer 2

Внесите следующие изменения

'add 4 lines
Dim colIBK As String, newFormula As String
On Error Resume Next
colIBK = Split(Cells(1, Application.Match("Managed Type", Range("A1:BB1"), 0)).Address(True, False), "$")(0)
On Error GoTo 0

Columns("Q:Q").Select
Selection.Clear
Range("Q1").Select
ActiveCell.FormulaR1C1 = "New Savings"
Range("Q2").Select

'add 1 line and change the next
newFormula = "=if(" & colIBK & "2 = ""IBK"","""",P2-(7/D2))"
ActiveCell.Formula = newFormula

Selection.AutoFill Destination:=Range("Q2:Q" & Range("A" & Rows.Count).End(xlUp).Row)
Range("Q2").Select

После получения colIBK вы можете проверить наличие "" и вывести сообщение об ошибке, если столбец не найден.

newFormula также может быть простоP2 "= if (" & colIBK & "2 =" "IBK" ", P2, P2- (7 / D2))"