Выполнять макрос, только если изменяется конкретное значение ячейки - PullRequest
Новая
       7

Выполнять макрос, только если изменяется конкретное значение ячейки

0 голосов
/ 05 ноября 2018

В ячейке E2 есть простая формула для сравнения, которая проверит наличие определенного текста. Как только это правда, он выполнит макрос, который запросит msgbox. Этот код работает нормально, но при внесении любых других изменений в лист снова выполнит макрос, даже если значение Cell E2 не изменилось. Как мне остановить дальнейшее выполнение макроса, если E2 вообще не изменяется? 

Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("E2")) Is Nothing Then
    If Target.Value = "True" Then
        Application.EnableEvents = False
        a = MsgBox("Test", vbYesNo, "Test")
        If a = vbYes Then
            Range("E3") = "003"
        Else
            Range("E3") = "001"
        End If

        Call ApplyMG
        Application.EnableEvents = True
    End If
End If
End Sub

РЕДАКТИРОВАТЬ: Благодаря комментарию ниже, удалена установка «старого кода» для того же диапазона в линии пересечения. Однако макрос больше не запускается.

Ответы [ 2 ]

0 голосов
/ 06 ноября 2018

Реальное решение

Результатом CountIf формулы является целое число или ошибка. Таким образом, у вас, вероятно, есть оператор If , который оценивает формулу CountIf в ячейке E2.
Используйте True без кавычек ( NOT"True"), если результатом является логическое значение (True или False).
Вы всегда должны использовать Option Explicit, чтобы заставить объявлять все переменные (ссылаясь на 'a').
Используйте константы в начале кода, чтобы иметь возможность быстро изменять значения в только в одном месте , если необходимо.
В вашем ответе код все еще выполняется все время (когда вычисляется рабочая таблица), если значение в E2 равно True, независимо от того, изменилось ли значение или нет.
Следующий код мог быть написан с использованием статической переменной внутри процедуры вместо выбранной переменной уровня модуля (blnCheck) вне процедуры. (Должно быть исследовано.) 

Option Explicit

Private blnCheck As Boolean

Private Sub Worksheet_Calculate()

  Const cStrRangeCheck As String = "E2"
  Const cStrRangeWrite As String = "E3"
  Const cStrResultYes As String = "003"
  Const cSTrResultNo As String = "001"

  Dim Msg As Variant
  Dim blnTarget As Boolean

  If IsError(Range(cStrRangeCheck).Value) Then GoTo TargetHandler

  blnTarget = Range(cStrRangeCheck).Value

  If blnTarget = True Then
    If blnCheck = False Then
      blnCheck = True
      Application.EnableEvents = False
      Msg = MsgBox("Test", vbYesNo, "Test")
      If Msg = vbYes Then
          Range(cStrRangeWrite) = cStrResultYes
        Else
          Range(cStrRangeWrite) = cSTrResultNo
      End If
      Call ApplyMG
      Application.EnableEvents = True
    End If
   Else 'blnTarget = False
    If blnCheck = True Then
      blnCheck = False
    End If
  End If

ProcedureExit:

Exit Sub

TargetHandler:
  MsgBox "blnTarget has to be a boolean."
  GoTo ProcedureExit

End Sub
0 голосов
/ 05 ноября 2018

Ну, оказывается, я слишком усложнял вещи. После некоторого исследования то, что я пытаюсь сделать, в первую очередь не будет работать с Worksheet_Change, так как это формула. Поэтому мне нужно только переместить мой код в Worksheet_Calculate. Нет необходимости в ненужном пересечении или чем-то еще, поскольку мой код должен только определить, является ли ячейка E2 истинной, что определяется формулой ячейки. Все остальное не имеет значения. 

Private Sub Worksheet_Calculate()
Dim trigger As Range
Set trigger = Range("E2")

If trigger.Value = "True" Then
    Application.EnableEvents = False
    a = MsgBox("Test", vbYesNo, "Test")
    If a = vbYes Then
        Range("E3") = "003"
    Else
        Range("E3") = "001"
    End If

    Call ApplyMG
    Application.EnableEvents = True
End If
End Sub
...