我有一个宏,希望在其中将公式应用于某些单元格。为了使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