我需要每次运行一个VBA脚本的单元格＆＃34; H18＆＃34;更改，但包含一个公式，并且没有数据被更改＆＃34;手动＆＃34;只有通过VBA脚本，有没有办法设置它？我尝试过一堆VBA脚本但没有成功，如果我手动更改它，它会起作用，但是当公式有效时，它会起作用。这是它应该运行的VBA脚本：
Sub Colorir()
Application.ScreenUpdating = False
Dim iRow, contagem
contagem = 0
iRow = 18
iColumn = 2
' ifim = Sheets("Plan1").Range("C8").Value - 1
Sheets("Calendario").Select
Do While iRow < 30
If Cells(iRow, 2) = "Não Recebido" Then
Cells(iRow, 2).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 8420607
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.color = -8356609
.TintAndShade = 0
End With
Else
End If
If Cells(iRow, 2) = "Abaixo do Previsto" Then
Cells(iRow, 2).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 10092390
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.color = -16711681
.TintAndShade = 0
End With
Else
End If
If Cells(iRow, 2) = "Igual ou Acima do Previsto" Then
Cells(iRow, 2).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 10092390
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.color = -6684826
.TintAndShade = 0
End With
Else
End If
If Cells(iRow, 3) = "Não Recebido" Then
Cells(iRow, 3).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 8420607
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.color = -8356609
.TintAndShade = 0
End With
Else
End If
If Cells(iRow, 3) = "Abaixo do Previsto" Then
Cells(iRow, 3).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 10092390
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.color = -16711681
.TintAndShade = 0
End With
Else
End If
If Cells(iRow, 3) = "Igual ou Acima do Previsto" Then
Cells(iRow, 3).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 10092390
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.color = -6684826
.TintAndShade = 0
End With
Else
End If
If Cells(iRow, 4) = "Não Recebido" Then
Cells(iRow, 4).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 8420607
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.color = -8356609
.TintAndShade = 0
End With
Else
End If
If Cells(iRow, 4) = "Abaixo do Previsto" Then
Cells(iRow, 4).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.color = -16711681
.TintAndShade = 0
End With
Else
End If
If Cells(iRow, 4) = "Igual ou Acima do Previsto" Then
Cells(iRow, 4).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 10092390
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.color = -6684826
.TintAndShade = 0
End With
Else
End If
If Cells(iRow, 5) = "Não Recebido" Then
Cells(iRow, 5).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 8420607
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.color = -8356609
.TintAndShade = 0
End With
Else
End If
If Cells(iRow, 5) = "Abaixo do Previsto" Then
Cells(iRow, 5).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 10092390
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.color = -16711681
.TintAndShade = 0
End With
Else
End If
If Cells(iRow, 5) = "Igual ou Acima do Previsto" Then
Cells(iRow, 5).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 10092390
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.color = -6684826
.TintAndShade = 0
End With
Else
End If
If Cells(iRow, 6) = "Não Recebido" Then
Cells(iRow, 6).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 8420607
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.color = -8356609
.TintAndShade = 0
End With
Else
End If
If Cells(iRow, 6) = "Abaixo do Previsto" Then
Cells(iRow, 6).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 10092390
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.color = -16711681
.TintAndShade = 0
End With
Else
End If
If Cells(iRow, 6) = "Igual ou Acima do Previsto" Then
Cells(iRow, 6).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 10092390
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.color = -6684826
.TintAndShade = 0
End With
Else
End If
If Cells(iRow, 7) = "Não Recebido" Then
Cells(iRow, 7).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 8420607
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.color = -8356609
.TintAndShade = 0
End With
Else
End If
If Cells(iRow, 7) = "Abaixo do Previsto" Then
Cells(iRow, 7).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 10092390
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.color = -16711681
.TintAndShade = 0
End With
Else
End If
If Cells(iRow, 7) = "Igual ou Acima do Previsto" Then
Cells(iRow, 7).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 10092390
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.color = -6684826
.TintAndShade = 0
End With
Else
End If
If Cells(iRow, 8) = "Não Recebido" Then
Cells(iRow, 8).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 8420607
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.color = -8356609
.TintAndShade = 0
End With
Else
End If
If Cells(iRow, 8) = "Abaixo do Previsto" Then
Cells(iRow, 8).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 10092390
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.color = -16711681
.TintAndShade = 0
End With
Else
End If
If Cells(iRow, 8) = "Igual ou Acima do Previsto" Then
Cells(iRow, 8).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 10092390
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.color = -6684826
.TintAndShade = 0
End With
Else
End If
If Range("S18").Value < Range("T18").Value Then
Range("B18, C18, D18, E18, F18, G18, H18").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 10092390
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If Range("S18").Value > Range("T18").Value Then
Range("B18, C18, D18, E18, F18, G18, H18").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If Range("T18").Value = 0 Then
Range("B18, C18, D18, E18, F18, G18, H18").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 8420607
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If Range("S20").Value < Range("T20").Value Then
Range("B20, C20, D20, E20, F20, G20, H20").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 10092390
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If Range("S20").Value > Range("T20").Value Then
Range("B20, C20, D20, E20, F20, G20, H20").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If Range("T20").Value = 0 Then
Range("B20, C20, D20, E20, F20, G20, H20").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 8420607
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If Range("S22").Value < Range("T22").Value Then
Range("B22, C22, D22, E22, F22, G22, H22").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 10092390
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If Range("S22").Value > Range("T22").Value Then
Range("B22, C22, D22, E22, F22, G22, H22").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If Range("T22").Value = 0 Then
Range("B22, C22, D22, E22, F22, G22, H22").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 8420607
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If Range("S24").Value < Range("T24").Value Then
Range("B24, C24, D24, E24, F24, G24, H24").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 10092390
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If Range("S24").Value > Range("T24").Value Then
Range("B24, C24, D24, E24, F24, G24, H24").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If Range("T24").Value = 0 Then
Range("B24, C24, D24, E24, F24, G24, H24").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 8420607
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If Range("S26").Value < Range("T26").Value Then
Range("B26, C26, D26, E26, F26, G26, H26").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 10092390
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If Range("S26").Value > Range("T26").Value Then
Range("B26, C26, D26, E26, F26, G26, H26").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If Range("T26").Value = 0 Then
Range("B26, C26, D26, E26, F26, G26, H26, B28, C28").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 8420607
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
iRow = iRow + 1
iColumn = iColumn + 1
Loop
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
If Range("B18, B19").Value = "" Then
Range("B18,B19").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If Range("C18, C19").Value = "" Then
Range("C18,C19").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If Range("D18, D19").Value = "" Then
Range("D18,D19").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If Range("E18, E19").Value = "" Then
Range("E18,E19").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If Range("E18, E19").Value = "" Then
Range("E18,E19").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If Range("F18, F19").Value = "" Then
Range("F18,F19").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If Range("G18, G19").Value = "" Then
Range("G18,G19").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If Range("H18, H19").Value = "" Then
Range("H18,H19").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If Range("B28, B29").Value = "" Then
Range("B28,B29").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If Range("C28, C29").Value = "" Then
Range("c28,c29").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If Range("d28, d29").Value = "" Then
Range("d28,d29").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If Range("e28, e29").Value = "" Then
Range("e28,e29").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If Range("f28, f29").Value = "" Then
Range("f28,f29").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If Range("g28, g29").Value = "" Then
Range("g28,g29").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If Range("h28, h29").Value = "" Then
Range("h28,h29").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If Range("D26, d27").Value = "" Then
Range("D26,D27").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If Range("e26, e27").Value = "" Then
Range("e26,e27").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If Range("f26, f27").Value = "" Then
Range("f26, f27").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If Range("g26, g27").Value = "" Then
Range("g26, g27").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
If Range("h26, h27").Value = "" Then
Range("h26,h27").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Range("Q6").Select
Application.ScreenUpdating = True
End Sub
答案 0 :(得分：1)
您必须使用单元格来跟踪以前的值。在下面的程序＆＃34; AnotherCell＆＃34;用于保持先前的值和＆＃34; FormulaCell＆＃34;是你有公式的地方。然后在工作表代码中使用以下过程，请记住不要在工作簿或模块页面中。
Private Sub Worksheet_Calculate()
If Range("AnotherCell") <> Range("FormulaCell").Value Then
Range("AnotherCell") = Range("Formula").Value
'Your Code Here
End If
End Sub
答案 1 :(得分：1)
您还可以在子结束后使用静态变量存储单元格值的信息：
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Value1 As Variant Static Value2 As Variant
Value1 = Range("B2005").Value
If Value1 <> Value2 Then
MsgBox "Cell " & Target.Address & " has changed."
End If
Value2 = Range("B2005").Value
End sub
答案 2 :(得分：0)
查看此article on Events in Excel VBA
您可以在Worksheet_Change事件过程中编写代码 一些行动取决于哪个细胞被改变或基于 新改变的价值。 （Worksheet_Change事件可能更合适 被称为Worksheet_AfterChange，因为它是在单元格之后调用的 已被更改
答案 3 :(得分：0)
仅当您有一个更改的单元格时，它才有效。如果您有一个表，并且您不知道何时以及哪个单元格发生更改，但您希望在表中的任何内容发生更改时运行宏，并且通过公式更改它。