Wie kann ich einen VBA-Code jedes Mal ausführen, wenn eine Zelle den Wert durch eine Formel ändert?

Question

Ich würde gerne wissen, wie kann ich einen VBA-Code jedes Mal, wenn eine Zelle bekommen Wert durch eine Formel geändert wird ?? Ich habe es geschafft, einen Code auszuführen, wenn eine Zelle ihren Wert vom Benutzer geändert hat, aber es funktioniert nicht w

Answer 1

Wenn ich eine Formel in Zelle A1 (zB = B1 * C1) habe und ich möchte einige VBA ausführen Code jeweils auf einem ordnungsgemäßen A1 Änderungen Zeit-Updates entweder Zelle B1 oder C1 dann kann ich die folgenden Befehle verwenden:

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 

---

aktualisieren

Soweit ich weiß, dass das Problem mit Worksheet_Calculate, dass es feuert für alle Zellen, die Formeln enthalten in der Kalkulationstabelle und Sie können nicht bestimmen, welche Zelle neu berechnet wurde Worksheet_Calculate bietet keine Target

Um dies zu umgehen, wenn Sie eine Reihe von Formeln in Spalte A haben und Sie möchten, welche zu aktualisieren und einen Kommentar zu dieser bestimmten Zelle hinzufügen, dann denke ich, den folgenden Code wird erreicht, dass:

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 

um zu erklären, für eine Formel eines der Eingangszellen in dieser Formel zu aktualisieren, müssen zB ändern Wenn Formel in A1 ist =B1 * C1 dann muss entweder B1 oder C1 ändern, um A1 zu aktualisieren.

Wir können das Ereignis Worksheet_Change verwenden, um eine Zellenänderung auf dem s/sheet zu erkennen und dann die Überwachungsfunktionen von Excel verwenden, um die Abhängigen, z. Zelle A1 ist sowohl von B1 als auch C1 abhängig, und in diesem Fall würde der Code Target.Dependents.Address$A$1 für jede Änderung an B1 oder C1 zurückgeben.

Dazu müssen wir jetzt nur noch überprüfen, ob die abhängige Adresse in Spalte A ist (mit Intersect). Wenn es in Spalte A ist, können wir der entsprechenden Zelle Kommentare hinzufügen.

Beachten Sie, dass dies nur zum einmaligen Hinzufügen von Kommentaren in eine Zelle funktioniert. Wenn Sie weiterhin Kommentare in derselben Zelle überschreiben möchten, müssen Sie den Code ändern, um zuerst die Existenz von Kommentaren zu überprüfen und anschließend nach Bedarf zu löschen.

Answer 2

Hier ist ein anderer Weg mit Klassen. Die Klasse kann die Zelle Anfangswert und Zelladresse speichern. Bei calculate event wird der aktuelle Wert der Adresse mit dem gespeicherten Anfangswert verglichen. Das folgende Beispiel wurde erstellt, um nur eine Zelle zu hören ("A2"), aber Sie können mehr Zellen im Modul hören oder die Klasse ändern, um mit größeren Bereichen zu arbeiten.

Class-Modul "Class1" genannt:

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 

die Klasse in normall Modul initialisieren.

Dim MyClass As Class1 

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

Answer 3

Hier ist mein Code:

Ich weiß, es sieht schrecklich aus, aber es funktioniert! Natürlich gibt es Lösungen, die viel besser sind.

Beschreibung des Codes:

Wenn die Arbeitsmappe öffnet, wird der Wert der Zellen B15 bis N15 sind in der Variablen PrevValb bis PrevValn gespeichert. Wenn ein Worksheet_Calculate() - Ereignis auftritt, werden die vorherigen Werte mit den tatsächlichen Werten der Zellen verglichen. Wenn sich der Wert ändert, wird die Zelle mit roter Farbe markiert. Dieser Code könnte mit Funktionen geschrieben werden, so dass er viel kürzer und einfacher zu lesen ist. Es gibt einen Farb-Reset-Knopf (Seenchanges), der die Farbe auf die vorherige Farbe zurücksetzt.

Arbeitsmappe:

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

Der Code, den Sie nicht verwendet nicht funktionieren, weil die Zelle Wechsel nicht die Zelle mit der Formel ist aber der Verkauf ... wird geändert :)

Hier ist, was Sie dem Modul des Arbeitsblatts hinzufügen sollten:

(Udated: Die Zeile "Set rDependents = Target.Dependents" wird einen Fehler auslösen, wenn es keine Abhängigen gibt. Dieses Update kümmert sich um diese.)

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 

Sie können diese erweitern, wenn es viele abhängige Zellen sind durch eine Reihe von Zelladressen in Frage aufsetzt. Dann würden Sie für jede Adresse im Array testen (dafür können Sie eine beliebige Schleifenstruktur verwenden) und haben dafür eine der Unterroutine entsprechende bedingte Unterroutine ausgeführt (SELECT CASE ...).