当单元格值按公式更改时运行 VBA 脚本
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/22413877/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
提示：将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间：2020-09-12 02:21:52 来源:igfitidea点击:
Run VBA Script When Cell Value Change by Formula
提问by Diego Patrocinio
I need to run a VBA script everytime the value of cell "H18" changes, but contains a formula, and no data is changed "Manually" only by VBA scripts, is there a way to set it up? I've tried a bunch of VBA scripts but no success at all, it works if I change it manually, but not when the formula works. This is the VBA script it should run:
每次单元格“H18”的值发生变化时，我都需要运行一个 VBA 脚本，但它包含一个公式，并且没有数据仅通过 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
采纳答案by Sandeep Kumar
You have to use a cell to keep track of previous value. In the below procedure "AnotherCell" is used for keeping the previous value and "FormulaCell" is where you have formula. Then use the below procedure on your worksheet code remember not in Workbook or Module page.
您必须使用单元格来跟踪以前的值。在下面的过程中，“AnotherCell”用于保留以前的值，“FormulaCell”是您拥有公式的地方。然后在您的工作表代码上使用以下过程，记住不要在工作簿或模块页面中。
Private Sub Worksheet_Calculate()
If Range("AnotherCell") <> Range("FormulaCell").Value Then
Range("AnotherCell") = Range("Formula").Value
'Your Code Here
End If
End Sub
回答by Caio
You may also store information of your cell value with an Static variable, after the sub ends:
在 sub 结束后，您还可以使用静态变量存储单元格值的信息：
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
回答by tmoore82
Check out this article on Events in Excel VBA
You can write code in the Worksheet_Change event procedure to take some action depending on which cell was changed or based upon the newly changed value. (The Worksheet_Change event might more properly be called Worksheet_AfterChange since it is called after the cell(s) has been changed
您可以在 Worksheet_Change 事件过程中编写代码以根据更改的单元格或基于新更改的值采取一些操作。（Worksheet_Change 事件可能更恰当地称为 Worksheet_AfterChange，因为它是在单元格更改后调用的
回答by Culi
it works only if you have one cell that changes. If you have a table, and you don't know when and which cell changes, but you want to run a macro when anything in the table changes, and it is changed by formula.
只有当你有一个改变的单元格时它才有效。如果您有一个表格，并且您不知道何时以及哪个单元格会发生变化，但是您想在表格中的任何内容发生变化时运行宏，并且它是由公式更改的。
