VBA将复杂的嵌套IF和公式写入表格

时间:2018-10-30 23:12:14

标签: excel vba excel-formula

我目前有一个复杂的公式,试图通过VBA放入单元格中。当前的工作公式(在BP2单元中)如下:

'=IF(X2="No Bonus",1,
'IF(AND(((AG2-AF2+1)/(365/12))>=50,AD2="N"),5,
'IF(AND(((AG2-AF2+1)/(365/12))>=40,AD2="N"),4,
'IF(AND(((AG2-AF2+1)/(365/12))>=30,AD2="N"),2,
'IF(AND(((AG2-AF2+1)/(365/12))>=20,AD2="N"),1,
'IF(AND(((AG2-AF2+1)/(365/12))>0,AD2="N"),0.5,
'IF(AND(((AG2-AF2+1)/(365/12))>=20,AD2="Y"),1,
'IF(AND(((AG2-AF2+1)/(365/12))>=15,AD2="Y"),2,
'IF(AND(((AG2-AF2+1)/(365/12))>=0,AD2="Y"),0.3,0)))))))))

我将代码放置在BP列中现有数据下方的可变范围内。我的代码当前如下:

Dim LastRowExisting As Long
Dim LastRowNew As Long

LastRowExisting = Worksheets("MyWorksheet").Range("CE1").Value 'LastRow of Existing data stored here by macro earlier
LastRowNew = Worksheets("MyWorksheet").Range("A" & rows.Count).End(xlUp).Row 'requires Column A "Source" is always populated on all lines    

Worksheets("MyWorksheet").Range("BP" & LastRowExisting + 1 & ":" & "BP" & LastRowNew).FormulaR1C1 = "=IF(RC[-44]=""No Bonus"",""1"", _
IF(AND(((RC[-35]-RC[-36]+1)/(365/12))>=50,RC[-38]=""N"",""5"", _
IF(AND(((RC[-35]-RC[-36]+1)/(365/12))>=40,RC[-38]=""N"",""4"", _
IF(AND(((RC[-35]-RC[-36]+1)/(365/12))>=30,RC[-38]=""N"",""2"", _
IF(AND(((RC[-35]-RC[-36]+1)/(365/12))>=20,RC[-18]=""N"",""1"", _
IF(AND(((RC[-35]-RC[-36]+1)/(365/12))>=0,RC[-38]=""N"",""0.5"", _
IF(AND(((RC[-35]-RC[-36]+1)/(365/12))>=20,RC[-38]=""Y"",""1"", _
IF(AND(((RC[-35]-RC[-36]+1)/(365/12))>=15,RC[-38]=""Y"",""2"", _
IF(AND(((RC[-35]-RC[-36]+1)/(365/12))>=0,RC[-38]=""Y"",""0.3"",""0"")))))))))"

在公式行上出现运行时错误'1004'“应用程序定义的错误或对象定义的错误”。我试图通过将它放在长行中来查看换行符是否是问题,但是我仍然遇到相同的错误。

我意识到这很可能是语法问题,但是我正在努力查看有什么问题。我知道这不是一个理想的解决方案(即丑陋的解决方案),但是鉴于此发生在较大的宏中,因此我希望此公式方法可以正常工作。

如果有帮助;通常的想法是根据两个条件得出一个值(5、4、2、1、5等)。第一个是(AG-AF+1)/(365/12)是否在某个范围内,第二个是Y中的简单NColumn AD标志。例如(AG2-AF2+1)/(365/12) = 45AD2 = N,然后我期望BP2 = 4

干杯!

3 个答案:

答案 0 :(得分:3)

写为Select Case可能是一个好主意,但请记住,宏记录器可以在这里成为您的朋友。只需在单元格BP2中记录输入公式,然后将输出复制到ActiveCell.FormulaR1C1之后即可:

 ActiveCell.FormulaR1C1 = _
        "=IF(RC[-44]=""No Bonus"",1,IF(AND(((RC[-35]-RC[-36]+1)/(365/12))>=50,RC[-38]=""N""),5,IF(AND(((RC[-35]-RC[-36]+1)/(365/12))>=40,RC[-38]=""N""),4,IF(AND(((RC[-35]-RC[-36]+1)/(365/12))>=30,RC[-38]=""N""),2,IF(AND(((RC[-35]-RC[-36]+1)/(365/12))>=20,RC[-38]=""N""),1,IF(AND(((RC[-35]-RC[-36]+1)/(365/12))>0,RC[-38]=""N""),0.5,IF(AND(((RC[-35]-RC[-36]+1)/(365/12))>=2" & _
        "0,RC[-38]=""Y""),1,IF(AND(((RC[-35]-RC[-36]+1)/(365/12))>=15,RC[-38]=""Y""),2,IF(AND(((RC[-35]-RC[-36]+1)/(365/12))>=0,RC[-38]=""Y""),0.3,0)))))))))" & _
        ""

答案 1 :(得分:1)

以这种方式尝试代码,其中每一行都是用引号引起来的单独字符串。

Worksheets("MyWorksheet").Range("BP" & LastRowExisting + 1 & ":" & "BP" & _
    LastRowNew).FormulaR1C1 = "=IF(RC[-44]=""No Bonus"",""1"", " & _
    "IF(AND(((RC[-35]-RC[-36]+1)/(365/12))>=50,RC[-38]=""N"",""5"", " & _
    "IF(AND(((RC[-35]-RC[-36]+1)/(365/12))>=40,RC[-38]=""N"",""4"", " & _
    "IF(AND(((RC[-35]-RC[-36]+1)/(365/12))>=30,RC[-38]=""N"",""2"", " & _
    "IF(AND(((RC[-35]-RC[-36]+1)/(365/12))>=20,RC[-18]=""N"",""1"", " & _
    "IF(AND(((RC[-35]-RC[-36]+1)/(365/12))>=0,RC[-38]=""N"",""0.5"", " & _
    "IF(AND(((RC[-35]-RC[-36]+1)/(365/12))>=20,RC[-38]=""Y"",""1"", " & _
    "IF(AND(((RC[-35]-RC[-36]+1)/(365/12))>=15,RC[-38]=""Y"",""2"", " & _
    "IF(AND(((RC[-35]-RC[-36]+1)/(365/12))>=0,RC[-38]=""Y"",""0.3"",""0"")))))))))"

可以在字符串之间使用换行符(下划线),如How to Break and Combine Statements in Code中的示例。

答案 2 :(得分:0)

键入&键入&键入

打开工作簿,打开VBE,插入新模块(或使用现有模块)并将以下代码粘贴到模块中:

Option Explicit

Function Nested(Range1 As Range, Range2 As Range, _
    Range3 As Range, Range4 As Range) As Single

'**** Customize BEGIN ******************
  'NOCase
  Const cStrSearch As String = "No Bonus"
  Const cSglYes As Single = 1
  'Period
  Const cDays As Integer = 365
  Const cMonths As Integer = 12
  'YesNo
  Const cStrYes As String = "Y"
  Const cStrNo As String = "N"
  'Title1 Source
  Const cSglN1 As Single = 50
  Const cSglN2 As Single = 40
  Const cSglN3 As Single = 30
  Const cSglN4 As Single = 20
  Const cSglN5 As Single = 0
  'Title1 Target
  Const cSglNA1 As Single = 5
  Const cSglNA2 As Single = 4
  Const cSglNA3 As Single = 2
  Const cSglNA4 As Single = 1
  Const cSglNA5 As Single = 0.5
  'Title2 Source
  Const cSglY1 As Single = 20
  Const cSglY2 As Single = 15
  Const cSglY3 As Single = 0
  'Title2 Target
  Const cSglYA1 As Single = 1
  Const cSglYA2 As Single = 2
  Const cSglYA3 As Single = 0.3
'**** Customize END ********************

  If Range1.Value2 = cStrSearch Then
    Nested = cSglYes
    Exit Function
  End If

  Nested = (Range4.Value2 - Range3.Value2) / cDays / cMonths

  Select Case UCase(Range2.Text) 'Remove 'Ucase' function for case-sensitive
    Case cStrNo
      Select Case Nested
        Case Is >= cSglN1: Nested = cSglNA1
        Case Is >= cSglN2: Nested = cSglNA2
        Case Is >= cSglN3: Nested = cSglNA3
        Case Is >= cSglN4: Nested = cSglNA4
        Case Is > cSglN5: Nested = cSglNA5
        Case Else
          Nested = 0 'Change if necessary
      End Select
    Case cStrYes
      Select Case Nested
        Case Is >= cSglY1: Nested = cSglYA1
        Case Is >= cSglY2: Nested = cSglYA2
        Case Is >= cSglY3: Nested = cSglYA3
        Case Else
          Nested = 0 'Change if necessary
      End Select
    Case Else
      Nested = 0 'Change if necessary
  End Select

'=IF(X2="No Bonus",1,
'IF(AND(((AG2-AF2+1)/(365/12))>=50,AD2="N"),5,
'IF(AND(((AG2-AF2+1)/(365/12))>=40,AD2="N"),4,
'IF(AND(((AG2-AF2+1)/(365/12))>=30,AD2="N"),2,
'IF(AND(((AG2-AF2+1)/(365/12))>=20,AD2="N"),1,
'IF(AND(((AG2-AF2+1)/(365/12))>0,AD2="N"),0.5,
'IF(AND(((AG2-AF2+1)/(365/12))>=20,AD2="Y"),1,
'IF(AND(((AG2-AF2+1)/(365/12))>=15,AD2="Y"),2,
'IF(AND(((AG2-AF2+1)/(365/12))>=0,AD2="Y"),0.3,0)))))))))
End Function

关闭VBE并在第二行 any 单元格中的工作表(Excel)中关闭(X2AD2AF2,{{1}除外})(例如您提到的AG2)使用以下公式:

BP2

根据需要复制/粘贴公式。