首页 文章

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

提问于
浏览 次
0

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

4 回答

  • 0

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

    看看这个article on Events in Excel VBA

    您可以在Worksheet_Change事件过程中编写代码，以根据更改的单元格或基于新更改的值执行某些操作 . （Worksheet_Change事件可能更适合称为Worksheet_AfterChange，因为在单元格更改后调用它

    回复于
  • 0

    在子结束之后，您还可以使用静态变量存储单元格值的信息：

    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
    回复于
  • 0

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

    回复于

相关问题