Private Sub Worksheet_Calculate()
Const SpeicherTabelle = "Tabelle2"
Dim Zelle As Range
Dim Farbe(1)
Dim i As Long
Dim t As Single
Dim Check
Farbe(0) = xlNone
Farbe(1) = 3
Check = True
For i = 1 To 10 'hier einstellen, wie oft geblinkt wird, immer gerade Zahl verwenden
For Each Zelle In ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas, 3)
If Zelle.Value Sheets(SpeicherTabelle).Range(Zelle.Address).Value Then
Zelle.Interior.ColorIndex = Farbe(i Mod 2)
Check = False
End If
Next
If Check Then Exit For
t = Timer + 0.2 'hier blinkgeschwindigkeit anpassen
Do
Loop Until Timer > t
Next
Me.Cells.Copy
Sheets(SpeicherTabelle).Cells(1, 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End Sub
alledings benötigt dieses Makro ein freies Tabellenblatt, in dem die Werte aus diesem Tabellenblatt gespeichert werden (damit geprüft werden kann, welche Zellen sich verändert haben)
das ist im Beispiel die "Tabelle2"
das muss halt bei bedarf angepasst werden.
gruß, Daniel
Private Sub Worksheet_Change(ByVal Target As Range)
Dim raZelle As Range
Dim arrFarben()
Dim loZaehler As Long
On Error Resume Next
If IsError(Target.Dependents) Then Exit Sub
On Error GoTo 0
ReDim arrFarben(0 To 1, 0 To Target.DirectDependents.Cells.Count - 1)
For Each raZelle In Target.DirectDependents
arrFarben(0, loZaehler) = raZelle.Address
arrFarben(1, loZaehler) = raZelle.Interior.Color
loZaehler = loZaehler + 1
Next raZelle
Target.DirectDependents.Interior.Color = 65535
Application.Wait Now + TimeValue("00:00:02")
loZaehler = 0
For Each raZelle In Target.DirectDependents
If arrFarben(1, loZaehler) = 16777215 Then
Range(arrFarben(0, loZaehler)).Interior.Pattern = xlNone
Else
Range(arrFarben(0, loZaehler)).Interior.Color = arrFarben(1, loZaehler)
End If
loZaehler = loZaehler + 1
Next raZelle
End Sub
Sobald in einer Zelle, auf die sich eine Formel bezieht etwas geändert wird, wird die Füllfarbe der Formelzelle für 2 Sekunden auf Gelb und anschließend wieder auf die Ursprungsfarbe gesetzt.