Comment puis-je exécuter un code VBA à chaque fois qu'une cellule obtient une valeur modifiée par une formule?

Question

Je voudrais savoir comment puis-je exécuter un code VBA chaque fois qu'une cellule obtient une valeur modifiée par une formule? Ive réussi à exécuter un code quand une cellule obtient sa valeur modifiée par l'utilisateur, mais il ne fonctionne pas w

Answer 1

Si j'ai une formule dans la cellule A1 (par exemple = B1 * C1) et je veux exécuter un certain VBA le code à chaque changement de A1 à temps en raison de mises à jour soit B1 cellulaire ou C1 alors je peux utiliser ce qui suit:

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 

---

Mise à jour

pour autant que je connais le problème avec Worksheet_Calculate est qu'il incendies pour toutes les cellules contenant des formules sur la feuille de calcul et vous ne pouvez pas déterminer quelle cellule a été recalculée (c.-à-d. Pour contourner cela, si vous avez un tas de formules dans la colonne A et que vous voulez identifier celui qui a mis à jour et ajouter un commentaire à cette cellule spécifique, alors je pense que le code suivant est

réalisera que:

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 

pour expliquer, pour une formule de mise à jour, l'une des cellules d'entrée dans cette formule doit changer par exemple si la formule au A1 est =B1 * C1 alors B1 ou C1 doit être modifié pour mettre à jour A1.

Nous pouvons utiliser l'événement Worksheet_Change pour détecter un changement de cellule sur la s/feuille et utilisez la fonctionnalité d'audit d'Excel pour retracer les personnes à charge par exemple la cellule A1 dépend à la fois de B1 et de C1 et, dans ce cas, le code Target.Dependents.Address renvoie $A$1 pour tout changement à B1 ou C1. Pour cette raison, tout ce que nous devons faire maintenant est de vérifier si l'adresse dépendante est dans la colonne A (en utilisant Intersect). Si c'est dans la colonne A, nous pouvons ajouter des commentaires à la cellule appropriée.

Notez que cela ne fonctionne que pour ajouter des commentaires une seule fois dans une cellule. Si vous souhaitez continuer à écraser les commentaires dans la même cellule, vous devez d'abord modifier le code pour vérifier l'existence des commentaires, puis les supprimer si nécessaire.

Answer 2

Voici une autre façon d'utiliser les classes. La classe peut stocker la valeur initiale de la cellule et l'adresse de la cellule. Sur l'événement de calcul, il compare la valeur actuelle de l'adresse avec la valeur initiale stockée. L'exemple ci-dessous est fait pour écouter une seule cellule ("A2"), mais vous pouvez initier l'écoute de plusieurs cellules dans le module ou changer la classe pour travailler avec des plages plus larges.

module de classe appelé "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 

initialiser la classe dans le module normall.

Dim MyClass As Class1 

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

Answer 3

Voici mon code:

Je sais qu'il a l'air terrible, mais ça marche! Bien sûr, il existe des solutions qui sont bien meilleures.

description du code:

Lorsque le classeur ouvre, la valeur des cellules B15 jusqu'à N15 sont enregistrées dans la variable PrevValb jusqu'à PrevValn. Si un événement Worksheet_Calculate() se produit, les valeurs précédentes sont comparées avec les valeurs réelles des cellules. S'il y a un changement de la valeur, la cellule est marquée avec la couleur rouge. Ce code pourrait être écrit avec des fonctions, de sorte qu'il est beaucoup plus court et plus facile à lire. Il existe un bouton de réinitialisation des couleurs (Seenchanges) qui réinitialise la couleur à la couleur précédente.

Cahier:

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 

Sheet1:

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

Le code utilisé ne fonctionne pas parce que le changement de cellule n'est pas la cellule avec la formule mais la vente ... étant changée :)

Voici ce que vous devez ajouter au module de la feuille de travail:

(Udated: La ligne "Set rDependents = Target.Dependents" va effacer une erreur s'il n'y a pas de dépendances. Cette mise à jour prend en charge de cela.)

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 

Vous pouvez étendre cela s'il y a beaucoup de cellules dépendantes par un tableau en Seting d'adresses de cellule en question. Ensuite, vous testeriez chaque adresse dans le tableau (vous pouvez utiliser n'importe quelle structure de boucle pour cela) et exécuteriez un sous-programme correspondant à la cellule modifiée (utilisez SELECT CASE ...) pour cela.