Как я могу запустить код VBA каждый раз, когда ячейка получает значение, измененное формулой?

Question

Я хотел бы знать, как я могу запускать код VBA каждый раз, когда ячейка get имеет значение, измененное формулой? Ive удалось запустить код, когда ячейка получает свое значение, измененное пользователем, но оно не работает w

Answer 1

Если у меня есть формула в ячейке A1 (например, = B1 * C1), и я хочу запустить некоторый VBA код каждый раз меняется A1 из-за обновлений к любой ячейке B1 или C1, то я могу использовать следующее:

Private Sub Worksheet_Calculate() 
    Dim target As Range 
    Set target = Range("A1") 

    If Not Intersect(target, Range("A1")) Is Nothing Then 
    //Run my VBA code 
    End If 
End Sub 

---

Update

насколько я знаю, проблема с Worksheet_Calculate что ли огни для всех ячеек, содержащих формулы на электронной таблице, и вы не можете определить, какая ячейка была пересчитана (т. Worksheet_Calculate не предоставляет объект Target)

Чтобы обойти это, если у вас есть куча формул в столбце A, и вы хотите определить, какой из них был обновлен, и добавить комментарий к этой конкретной ячейке, тогда я думаю, что следующий код будет добиться того, что:

Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim updatedCell As Range 
    Set updatedCell = Range(Target.Dependents.Address) 

    If Not Intersect(updatedCell, Range("A:A")) Is Nothing Then 
     updatedCell.AddComment ("My Comments") 
    End If 

End Sub 

чтобы объяснить, формула для обновления, один из входных ячеек в этой формуле необходимо изменить, например, если формула в A1 равна =B1 * C1, то либо B1, либо C1 необходимо изменить для обновления A1.

Мы можем использовать событие Worksheet_Change для обнаружения изменения ячейки на листе s /, а затем использовать функции аудита Excel для отслеживания иждивенцев, например. ячейка A1 зависит как от B1, так и от C1, и в этом случае код Target.Dependents.Address вернет $A$1 для любого изменения на B1 или C1.

Учитывая это, все, что нам нужно сделать, это проверить, находится ли зависимый адрес в столбце A (с использованием Intersect). Если он находится в столбце A, мы можем добавить комментарии к соответствующей ячейке.

Обратите внимание, что это работает только для добавления комментариев только в ячейку. Если вы хотите продолжить перезаписывать комментарии в одной и той же ячейке, вам нужно будет изменить код, чтобы сначала проверить наличие комментариев, а затем удалить по мере необходимости.

Answer 2

Вот еще один способ использования классов. Класс может хранить начальное значение ячейки и адрес ячейки. В случае события вычисления будет сравниваться текущее значение адреса с сохраненным начальным значением. Пример, приведенный ниже, предназначен для прослушивания только одной ячейки («A2»), но вы можете инициировать прослушивание большего количества ячеек в модуле или изменить класс для работы с более широкими диапазонами.

модуль класса

называется "Class1":

Public WithEvents MySheet As Worksheet 
Public MyRange As Range 
Public MyIniVal As Variant 

Public Sub Initialize_MySheet(Sh As Worksheet, Ran As Range) 
    Set MySheet = Sh 
    Set MyRange = Ran 
    MyIniVal = Ran.Value 
End Sub 
Private Sub MySheet_Calculate() 

If MyRange.Value <> MyIniVal Then 
    Debug.Print MyRange.Address & " was changed from " & MyIniVal & " to " & MyRange.Value 
    StartClass 
End If 

End Sub 

Инициализировать класс в Normall модуле.

Dim MyClass As Class1 

Sub StartClass() 
Set MyClass = Nothing 
Set MyClass = New Class1 
MyClass.Initialize_MySheet ActiveSheet, Range("A2") 
End Sub 

Answer 3

Вот мой код:

Я знаю, это выглядит ужасно, но это работает! Конечно, есть решения, которые намного лучше.

Описание кода:

Когда Workbook размыкается, значение ячейки B15 до N15 сохраняются в переменной PrevValb до PrevValn. Если происходит событие Worksheet_Calculate(), предыдущие значения сравниваются с фактическими значениями ячеек. Если происходит изменение значения, ячейка отмечена красным цветом. Этот код может быть написан с функциями, так что он намного короче и легче читать. Имеется кнопка сброса цвета (Seenchanges), которая сбрасывает цвет на предыдущий цвет.

Workbook:

Private Sub Workbook_Open() 
PrevValb = Tabelle1.Range("B15").Value 
PrevValc = Tabelle1.Range("C15").Value 
PrevVald = Tabelle1.Range("D15").Value 
PrevVale = Tabelle1.Range("E15").Value 
PrevValf = Tabelle1.Range("F15").Value 
PrevValg = Tabelle1.Range("G15").Value 
PrevValh = Tabelle1.Range("H15").Value 
PrevVali = Tabelle1.Range("I15").Value 
PrevValj = Tabelle1.Range("J15").Value 
PrevValk = Tabelle1.Range("K15").Value 
PrevVall = Tabelle1.Range("L15").Value 
PrevValm = Tabelle1.Range("M15").Value 
PrevValn = Tabelle1.Range("N15").Value 
End Sub 

Modul:

Sub Seenchanges_Klicken() 
Range("B15:N15").Interior.Color = RGB(252, 213, 180) 
End Sub 

Лист1:

Private Sub Worksheet_Calculate() 
If Range("B15").Value <> PrevValb Then 
    Range("B15").Interior.Color = RGB(255, 0, 0) 
    PrevValb = Range("B15").Value 
End If 
If Range("C15").Value <> PrevValc Then 
    Range("C15").Interior.Color = RGB(255, 0, 0) 
    PrevValc = Range("C15").Value 
End If 
If Range("D15").Value <> PrevVald Then 
    Range("D15").Interior.Color = RGB(255, 0, 0) 
    PrevVald = Range("D15").Value 
End If 
If Range("E15").Value <> PrevVale Then 
    Range("E15").Interior.Color = RGB(255, 0, 0) 
    PrevVale = Range("E15").Value 
End If 
If Range("F15").Value <> PrevValf Then 
    Range("F15").Interior.Color = RGB(255, 0, 0) 
    PrevValf = Range("F15").Value 
End If 
If Range("G15").Value <> PrevValg Then 
    Range("G15").Interior.Color = RGB(255, 0, 0) 
    PrevValg = Range("G15").Value 
End If 
If Range("H15").Value <> PrevValh Then 
    Range("H15").Interior.Color = RGB(255, 0, 0) 
    PrevValh = Range("H15").Value 
End If 
If Range("I15").Value <> PrevVali Then 
    Range("I15").Interior.Color = RGB(255, 0, 0) 
    PrevVali = Range("I15").Value 
End If 
If Range("J15").Value <> PrevValj Then 
    Range("J15").Interior.Color = RGB(255, 0, 0) 
    PrevValj = Range("J15").Value 
End If 
If Range("K15").Value <> PrevValk Then 
    Range("K15").Interior.Color = RGB(255, 0, 0) 
    PrevValk = Range("K15").Value 
End If 
If Range("L15").Value <> PrevVall Then 
    Range("L15").Interior.Color = RGB(255, 0, 0) 
    PrevVall = Range("L15").Value 
End If 
If Range("M15").Value <> PrevValm Then 
    Range("M15").Interior.Color = RGB(255, 0, 0) 
    PrevValm = Range("M15").Value 
End If 
If Range("N15").Value <> PrevValn Then 
    Range("N15").Interior.Color = RGB(255, 0, 0) 
    PrevValn = Range("N15").Value 
End If 
End Sub 

Answer 4

Код, который вы использовали не работает, потому что изменение ячейки не ячейка с формулой, но продается ... меняется)

Вот что вы добавили к рабочему модулю:

(Устаревший: строка «Установить rDependents = Target.Dependents» будет разорвать ошибку, если нет иждивенцев. Это обновление заботится об этом.)

Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim rDependents As Range 

    On Error Resume Next 
    Set rDependents = Target.Dependents 
    If Err.Number > 0 Then 
     Exit Sub 
    End If 
    ' If the cell with the formula is "F160", for example... 
    If Not Application.Intersect(rDependents, Range("F160")) Is Nothing Then 
     Call abc 
    End If 
End Sub 

Private Sub abc() 
    MsgBox """abc()"" is running now" 
End Sub 

Вы можете расширить это, если есть много зависимых клеток путем седений вверх массив ячеек адресов в вопросе. Затем вы будете тестировать каждый адрес в массиве (для этого вы можете использовать любую структуру циклов) и выполнили подпрограмму, отвечающую за измененную ячейку (используйте SELECT CASE ...) для этого.