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

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

Если у меня есть формула в ячейке A1 (eg = 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 

Обновить

Насколько я знаю, проблема с 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 return $A$1 для любого изменения в B1 или C1 .

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

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

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

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

(Udated: строка «Set 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 …) для этого.

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

Класс classа, называемый «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 

Инициализировать class в модуле normall.

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

Вот мой код:

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

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

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

Рабочая тетрадь:

 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 
Давайте будем гением компьютера.