keine Formel: sichtbar machen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Not (Intersect(UsedRange, Target) Is Nothing) Then If Not Target.HasFormula Then Target.Interior.ColorIndex = 3 Else Target.Interior.ColorIndex = xlNone End If End If End Sub

in einem Modul Option Explicit Public X As Boolean in der Tabelle Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) If ActiveCell.HasFormula = True Then X = True If ActiveCell.HasFormula = False Then X = False End Sub Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("A1:A10")) Is Nothing Then If X = True Then MsgBox "Achtung es wurde eine Formel überschrieben" End If End If End Sub

Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) If ActiveCell.HasFormula = True Then X = True If ActiveCell.HasFormula = False Then X = False End Sub Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("A1:CV500")) Is Nothing Then If X = True Then MsgBox "Achtung es wurde eine Formel überschrieben" End If End If End Sub

Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, [formelcheck]) Is Nothing Then If X = True Then MsgBox "Achtung es wurde eine Formel überschrieben" End If End If End Sub

Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) If ActiveCell.HasFormula = True Then X1 = True: OldFormel = Target.Formula If ActiveCell.HasFormula = False Then X1 = False End Sub Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, [Formelcheck1]) Is Nothing Then If X1 = True Then MsgBox "Achtung es wurde folgende Formel überschrieben" & vbLf & "in " & Target.Address & ": " _ & OldFormel End If End If End Sub

Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) If ActiveCell.HasFormula = True Then x2 = True: OldFormel = Target.FormulaLocal If ActiveCell.HasFormula = False Then x2 = False End Sub Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Not Intersect(Target, [Formelcheck2]) Is Nothing Then If x2 = True Then MsgBox "Achtung es wurde folgende Formel überschrieben" & vbLf & "in " & Target.Address & ": " _ & OldFormel End If End If End Sub

Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) If ActiveCell.HasFormula = True Then X = True If ActiveCell.HasFormula = False Then X = False End Sub Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("A1:CV500")) Is Nothing Then If X = True And Not Target.HasFormula Then MsgBox "Achtung es wurde eine Formel überschrieben" End If End If End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range) If ActiveCell.HasFormula = True Then x3 = True: OldFormel = Target.Formula.local If ActiveCell.HasFormula = False Then x3 = False End Sub

Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Not Intersect(Target, [Formelcheck3]) Is Nothing Then If x3 = True And Not Target.HasFormula Then MsgBox "Achtung es wurde eine Formel überschrieben" & vbLf & "in " & Target.Address & ": _ " & OldFormel End If End If End Sub

Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) If ActiveCell.HasFormula = True Then X = True Formel = ActiveCell.FormulaLocal Else X = False End If End Sub Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("A1:CV500")) Is Nothing Then If X = True And Not Target.HasFormula Then MsgBox "Achtung, folgende Formel wurde überschrieben" & Chr(13) & Formel End If End If End Sub

Hallo Peter
Nach der glorreichen Idee von Reinhard den Code so anzupassen hier der Code komplett
in ein Modul


Option Explicit
Public X1 As Boolean, x2 As Boolean, x3 As Boolean
Public OldFormel As String

in die Tabelle mit dem Bereich [Formelcheck1]


Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If ActiveCell.HasFormula = True Then X1 = True: OldFormel = Target.Formula
If ActiveCell.HasFormula = False Then X1 = False
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [Formelcheck1]) Is Nothing Then
If X1 = True And Not Target.HasFormula Then
MsgBox "Achtung es wurde folgende Formel überschrieben" & vbLf & "in " & Target.Address & ": " _
& OldFormel
End If
End If
End Sub

in die Tabelle mit dem Bereich [Formelcheck2]


Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If ActiveCell.HasFormula = True Then x2 = True: OldFormel = Target.FormulaLocal
If ActiveCell.HasFormula = False Then x2 = False
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [Formelcheck2]) Is Nothing Then
If x2 = True And Not Target.HasFormula Then
MsgBox "Achtung es wurde folgende Formel überschrieben" & vbLf & "in " & Target.Address & ": " _
& OldFormel
End If
End If
End Sub

in die Tabelle mit dem Bereich [Formelcheck3]


Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If ActiveCell.HasFormula = True Then x3 = True: OldFormel = Target.FormulaLocal
If ActiveCell.HasFormula = False Then x3 = False
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [Formelcheck3]) Is Nothing Then
If x3 = True And Not Target.HasFormula Then
MsgBox "Achtung es wurde folgende Formel überschrieben" & vbLf & "in " & Target.Address & ": " _
& OldFormel
End If
End If
End Sub

Hier die neue Datei: https://www.herber.de/bbs/user/46013.xls
Userbild

Beliebteste Forumthreads (12 Monate)

32 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

32
Beiträge zum Forumthread

Beiträge zu diesem Forumthread