VBA不会在范围上输入公式

时间:2019-09-04 17:14:39

标签: excel vba

我有一个宏,希望在其中将公式应用于某些单元格。为了使R1C1公式正确,我只记录了该公式。 当我去测试它时,我收到了错误1004,但是选择了一个范围,所以我不确定这是怎么回事...

如果有人可以帮助我,我很困。谢谢!

UltLinhaBD = Cells(800, 1).End(xlUp).Row

        For LinhaAba = 2 To UltLinhaBD

            If Cells(LinhaAba, 1) <> "" Then
                Cells(LinhaAba, 20) = _
                    "=IF(AND(RC5=Infos!R2C4,RC9='Premissas Financeiras'!R6C2,RC3='Premissas Financeiras'!R2C3),(-RC16*'Premissas Financeiras'!R6C3)," & Chr(10) & "IF(AND(RC5=Infos!R2C4,RC9='Premissas Financeiras'!R7C2,RC3='Premissas Financeiras'!R2C3),(-RC16*'Premissas Financeiras'!R7C3)," & Chr(10) & "IF(AND(RC5=Infos!R2C4,RC9='Premissas Financeiras'!R6C2,RC3='Premissas Financeiras'!R2C4),(-RC16*'Premissas Financ" & _
                    "6C4)," & Chr(10) & "IF(AND(RC5=Infos!R2C4,RC9='Premissas Financeiras'!R7C2,RC3='Premissas Financeiras'!R2C4),(-RC16*'Premissas Financeiras'!R7C4)," & Chr(10) & "IF(AND(RC5=Infos!R2C4,RC9='Premissas Financeiras'!R6C2,RC3='Premissas Financeiras'!R2C5),(-RC16*'Premissas Financeiras'!R6C5)," & Chr(10) & "IF(AND(RC5=Infos!R2C4,RC9='Premissas Financeiras'!R7C2,RC3='Premissas Financeiras'!R2C5),(-RC16*'Premissas F" & _
                    "s'!R7C5),))))))"
                Cells(LinhaAba, 22) = "=-RC[-2]*RC[-1]"
                Cells(LinhaAba, 4) = "Dedução"
            End If

        Next LinhaAba



公式本身是:

=IF(AND($E3=Infos!$D$2;$I3='Premissas Financeiras'!$B$6;$C3='Premissas Financeiras'!$C$2);(-$P3*'Premissas Financeiras'!$C$6); IF(AND($E3=Infos!$D$2;$I3='Premissas Financeiras'!$B$7;$C3='Premissas Financeiras'!$C$2);(-$P3*'Premissas Financeiras'!$C$7); IF(AND($E3=Infos!$D$2;$I3='Premissas Financeiras'!$B$6;$C3='Premissas Financeiras'!$D$2);(-$P3*'Premissas Financeiras'!$D$6); IF(AND($E3=Infos!$D$2;$I3='Premissas Financeiras'!$B$7;$C3='Premissas Financeiras'!$D$2);(-$P3*'Premissas Financeiras'!$D$7); IF(AND($E3=Infos!$D$2;$I3='Premissas Financeiras'!$B$6;$C3='Premissas Financeiras'!$E$2);(-$P3*'Premissas Financeiras'!$E$6); IF(AND($E3=Infos!$D$2;$I3='Premissas Financeiras'!$B$7;$C3='Premissas Financeiras'!$E$2);(-$P3*'Premissas Financeiras'!$E$7);))))))

我用宏记录器将其转换为vba,因为我真的不知道如何很好地使用.FormulaR1C1表示法。

完整子目录为:


Sub Deduções()

Dim Aba As String
Dim iCounter As Long
Dim Coluna As Long
Dim Linha As Long
Dim ColAba As Long
Dim LinhaAba As Long
Dim UltLinhaAba As Long
Dim UltLinhaBD As Long

Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range

Dim Iniciativa As String
Dim Tipo As String
Dim Ano As Long


' Deduções

' Inserir função que multiplica total da receita à premissa de dedução e função que multiplica valor unitário pela qtde
    Sheets("Deduções").Select

        Range("T2").Select
        ActiveCell.FormulaR1C1 = "=RC[-4]*'Premissas Financeiras'!R7C3"
        Range("T2").Select
        Selection.AutoFill Destination:=Range("T2:T7"), Type:=xlFillDefault


        UltLinhaBD = Cells(800, 1).End(xlUp).Row

        For LinhaAba = 2 To UltLinhaBD

            If Cells(LinhaAba, 1) <> "" Then
                Cells(LinhaAba, 20) = "=RC[-4]*'Premissas Financeiras'!R7C3"
                Cells(LinhaAba, 22) = "=-RC[-2]*RC[-1]"
                Cells(LinhaAba, 4) = "Dedução"
            End If

        Next LinhaAba

' Colar quantidade
    Columns("Q:Q").Select
    Selection.Copy
    Columns("U:U").Select
    ActiveSheet.Paste

' Colar valor
    Columns("T:V").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

' Deletar colunas indesejadas
    Columns("P:S").Select
    Selection.Delete

    UltLinhaBD = Cells(500, 1).End(xlUp).Row

    For LinAba = 2 To UltLinhaBD

        If Cells(LinAba, 1).Value = "INICIATIVA" Then
            Cells(LinAba, 1).EntireRow.Delete
        End If

    Next LinAba

' Cabeçalho

    Cells(1, 1).Value = "INICIATIVA"
    Cells(1, 2).Value = "TIPO"
    Cells(1, 3).Value = "ANO"
    Cells(1, 4).Value = "R/D"
    Cells(1, 5).Value = "AGRUPAMENTO"
    Cells(1, 6).Value = "ETAPA"
    Cells(1, 7).Value = "CAT 3"
    Cells(1, 8).Value = "CAT 4"
    Cells(1, 9).Value = "CAT 5"
    Cells(1, 10).Value = "CAT 6"
    Cells(1, 11).Value = "DETALHAMENTO"
    Cells(1, 12).Value = "EMPRESA"
    Cells(1, 13).Value = "CONTRIBUIÇÃO"
    Cells(1, 14).Value = "UNIDADE"
    Cells(1, 15).Value = "VISÃO"
    Cells(1, 16).Value = "VALOR UNITÁRIO"
    Cells(1, 17).Value = "QUANTIDADE"
    Cells(1, 18).Value = "TOTAL"
    Cells(1, 19).Value = "OBS"


Sheets("Deduções").Select

    Set rng1 = Cells.Find("*", [a1], xlFormulas, , xlByRows, xlPrevious)
    Set rng2 = Cells.Find("*", [a1], xlFormulas, , xlByColumns, xlPrevious)
    If Not rng1 Is Nothing Then
        Set rng3 = Range([a1], Cells(rng1.Row, rng2.Column))
        'if you need to actual select the range (which is rare in VBA)
        Application.Goto rng3
    Else
        MsgBox "sheet is blank", vbCritical
    End If

    Selection.Copy
    Sheets("BD").Select
    Range("A900").Select
    Selection.End(xlUp).Select
    Selection.Offset(1, 0).Select
    ActiveSheet.Paste

Application.ScreenUpdating = True

End Sub

0 个答案:

没有答案