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

所附图片为样本数据。我显然处理的数据远远超过此。我需要公式知道不通过宏从IBK中减去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））”

公式适用于某些行

2 个答案: