Excel / VBA / Macro根据具体条件反转公式

时间:2016-03-10 06:56:09

标签: vba macros formula reverse

[code}

范围(" A2&#34)。选择     a =范围(选择,选择。结束(xlDown))。计数+ 1

Range("N2").Select
ActiveCell.FormulaR1C1 = _
    "=IF(RC[-4]="""","""",IF(RC[-2]=""NA"",""N/A"",IF(RC[-2]=""N/A""," & _
          """N/A"",IF(RC[-2]>=RC[-4],""Met"",""Not Met""))))"
Selection.AutoFill Destination:=Range(Cells(2, 14), Cells(a, 14)) 

[代码] 这是我目前编写公式的代码。这是完美的工作,但我需要添加一些东西。对于在F列中具有特定文本的每一行,我需要有一个反向公式。这些是:AR17-ReportCS02-ReportHSCBD-ReportKHG-Report。如果列F具有任何这些文本。列N中的公式应该颠倒过来。 而不是>,应该是< 。我是vba / macro的新手。

[code]

MAXROW = 10000 
 For i = 1 To MAXROW
        Range("N" & i).Select
        If Not IsError(Application.Match(Range("F" & i), Array("AR17 - Past Due Receivables Outstanding", "AR18 - Past Due Receivables Outstanding greater than 60 days", "HRSC01NA - Call Abandonment Rate ", "ESC07 - Call Abandonment"), False)) Then   
           ActiveCell.FormulaR1C1 = "=IF(RC[-2]<=RC[-4],""Met"",""Not Met"")"
        Else
   ActiveCell.FormulaR1C1 = _     "=IF(RC[-4]="""","""",IF(RC[-2]=""NA"",""N/A"",IF(RC[-2]=""N/A"",""N/A"",IF(RC[-2]>=RC[-4],""Met"",""Not Met""))))"
        End If
     Next

[代码]

现在这段代码正在运行,它正在颠倒公式。但是,当我将代码替换为此代码以反转公式时,我的另一个工作表中的数据透镜没有更新或没有获取数据。

现在这是我的全部代码:

[代码]

    Sub Button5_Click()

Dim b As Integer
    Sheets("database_2").Select
    ActiveSheet.Range("$A$1:$P$7436").AutoFilter Field:=8, Criteria1:="=LIVE", _
        Operator:=xlOr, Criteria2:="="
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    Selection.AutoFilter
    Range("A1").Select
    Selection.AutoFilter
    Range("A2").Select
    b = Range(Selection, Selection.End(xlDown)).Count + 2
    Range("A2").Select
    Cells(b, 1).Select

     Windows("NEW Consolidated Data Point System_Final.xlsm").Activate
    Range("D1").AutoFilter Field:=4, Criteria1:=Array("HR", "OM", "PY"), Operator:=xlFilterValues

    For Each rngCell In Range("D2:D" & Range("D2").End(xlDown).Row)
    If Not rngCell.EntireRow.Hidden Then

    rngCell.Value = "ES"

    End If
    Next rngCell
    Selection.AutoFilter

    Windows("Compliance.csv").Activate
    Range("I1").AutoFilter Field:=9, Criteria1:=Array("KPI", "CPI", "GPI"), Operator:=xlFilterValues

    For Each rngCell In Range("I2:I" & Range("I2").End(xlDown).Row)
    If Not rngCell.EntireRow.Hidden Then

    rngCell.Value = "NBS"

    End If
    Next rngCell
    Selection.AutoFilter


    Range("N2").Select
    i = Range(Selection, Selection.End(xlDown)).Count + 1

    Range("P2").Select
    ActiveCell.FormulaR1C1 = "=TEXT(RC[-2],""mmmm"")"
    Range("P2").Select
    Selection.AutoFill Destination:=Range(Cells(2, 16), Cells(i, 16))
    Range(Cells(2, 16), Cells(i, 16)).Select
    Selection.Copy
    Range("N2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range(Cells(2, 16), Cells(i, 16)).Delete


    Range("C2:M2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
     Windows("NEW Consolidated Data Point System_Final.xlsm").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Windows("Compliance.csv").Activate
    Range(Cells(2, 15), Cells(i, 15)).Copy

    Windows("NEW Consolidated Data Point System_Final.xlsm").Activate
   Cells(b, 12).Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Windows("Compliance.csv").Activate
   Range(Cells(2, 14), Cells(i, 14)).Copy

    Windows("NEW Consolidated Data Point System_Final.xlsm").Activate
     Cells(b, 13).Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


    Range("A2").Select
    A = Range(Selection, Selection.End(xlDown)).Count + 1

     Range("N2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-4]="""","""",IF(RC[-2]=""NA"",""N/A"",IF(RC[-2]=""N/A"",""N/A"",IF(RC[-2]>=RC[-4],""Met"",""Not Met""))))"
    Selection.AutoFill Destination:=Range(Cells(2, 14), Cells(A, 14))

    Range("O2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-1]="""","""",IF(RC[-1]=""NA"",""N/A"",IF(RC[-1]=""Met"",1,0)))"
    Selection.AutoFill Destination:=Range(Cells(2, 15), Cells(A, 15))

     Range("P2").Select
    ActiveCell.FormulaR1C1 = _
       "=IF(RC[-2]="""","""",IF(RC[-2]=""NA"",0,IF(RC[-2]=""N/A"",0,1)))"
    Selection.AutoFill Destination:=Range(Cells(2, 16), Cells(A, 16))

    DataArea = "database_2!R1C1:R" & A & "C16"

     Sheets("Per Month").Select
    Range("Q12").Select
    ActiveSheet.PivotTables("PivotTable5").ChangePivotCache ActiveWorkbook. _
        PivotCaches.Create(SourceType:=xlDatabase, SourceData:=DataArea _
        , Version:=xlPivotTableVersion15)
    ActiveWorkbook.RefreshAll

      Sheets("Per Market").Select
    Range("Q12").Select
    ActiveSheet.PivotTables("PivotTable4").ChangePivotCache ActiveWorkbook. _
        PivotCaches.Create(SourceType:=xlDatabase, SourceData:=DataArea _
        , Version:=xlPivotTableVersion15)
    ActiveWorkbook.RefreshAll

Sheets("Computation").Select
    Range("Q12").Select
    ActiveSheet.PivotTables("PivotTable7").ChangePivotCache ActiveWorkbook. _
        PivotCaches.Create(SourceType:=xlDatabase, SourceData:=DataArea _
        , Version:=xlPivotTableVersion15)
    ActiveWorkbook.RefreshAll

    Sheets("database_2").Select


End Sub

[代码]

1 个答案:

答案 0 :(得分:1)

反转公式的程序可能如下:

Sub ReverseFormula()

    Dim c As Range
    Dim sReversedFormula As String

    For Each c In ThisWorkbook.Worksheets("TypeProperName").Range("F1:F100").Cells
        Select Case c.Value
            Case "AR17-Report", "CS02-Report", "HSCBD-Report", "KHG-Report"

                '=IF(J2="","",IF(L2="NA","N/A",IF(L2="N/A","N/A",IF(L2<=J2,"Met","Not Met")))) 
                sReversedFormula = "=IF(J" & c.Row & "='',''IF(L" & c.Row & "='NA', 'N/A', IF(L" & c.Row & "<=J" & c.Row & ", 'Met', 'Not Met')))"
                c.Offset(ColumnOffset:=8).Formula = sReversedFormula
            Case Else
                'do nothing
        End Select
    Next

End Sub

如何使用它?

  1. 打开要更改的文件
  2. 转到代码窗格(ALT + F11)
  3. 插入新模块(Insert menu =&gt;模块)
  4. 复制并粘贴上述程序
  5. 根据需要更改代码
  6. 跑步(F5)
  7. 注意:在执行上述代码之前,请不要忘记备份文件