当单元格值按公式更改时运行 VBA 脚本答案

【问题标题】：Run VBA Script When Cell Value Change by Formula当单元格值按公式更改时运行 VBA 脚本
【发布时间】：2016-08-27 16:21:56
【问题描述】：

每次单元格“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

【问题讨论】：

你好 Diego，手动更改单元格后宏在做什么？
请告诉我们单元格H18中的公式
H18 中的公式是“=H8”，H8 中的公式是“=if(Dina1!H5="";"";Dina1!H5)" 宏很大，我会编辑它的问题。
我认为这可以完成你正在寻找的东西：stackoverflow.com/a/11409569/1693085
我试过了，还是不行..

标签： vba excel

【解决方案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】：

您必须使用单元格来跟踪以前的值。在下面的过程中，“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

【讨论】：

【解决方案3】：

看看这个article on Events in Excel VBA

您可以在 Worksheet_Change 事件过程中编写代码以采取一些动作取决于哪个单元格被更改或基于新更改的值。（Worksheet_Change 事件可能更合适被称为 Worksheet_AfterChange 因为它是在单元格之后调用的已更改

【讨论】：

【解决方案4】：

只有当你有一个单元格发生变化时它才有效。如果您有一个表格，并且您不知道何时以及哪个单元格发生更改，但是您想在表格中的任何内容发生更改时运行宏，并且它是由公式更改的。

【讨论】：