Запуск сценария VBA при изменении значения ячейки по формуле
Мне нужно запускать сценарий VBA каждый раз, когда значение ячейки "H18" изменяется, но содержит формулу, и никакие данные не изменяются "Вручную" только сценариями 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
5 ответов
Решение
Вы должны использовать ячейку, чтобы отслеживать предыдущее значение. В приведенной ниже процедуре "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
Вы также можете сохранить информацию о значении вашей ячейки с помощью статической переменной после того, как подпрограмма завершится:
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
Поместите это в код рабочего листа и измените диапазоны ячеек и имя макроса.
Private Sub Worksheet_Calculate()
Dim Xrg As Range
Set Xrg = Range("C2:C8")
If Not Intersect(Xrg, Range("C2:C8")) Is Nothing Then
Macro1
End If
End Sub
Это работает, только если у вас есть одна ячейка, которая меняется. Если у вас есть таблица, и вы не знаете, когда и какая ячейка изменяется, но вы хотите запускать макрос, когда что-либо в таблице изменяется, и это изменяется по формуле.
Проверьте эту статью о событиях в Excel VBA
Вы можете написать код в процедуре события Worksheet_Change, чтобы выполнить какое-либо действие в зависимости от того, какая ячейка была изменена или на основе вновь измененного значения. (Событие Worksheet_Change может более правильно называться Worksheet_AfterChange, поскольку оно вызывается после изменения ячейки (я).