Zellwert bei Eingabe löschen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_Change(ByVal Target As Range) With Target If .Address(0, 0) = "B1" Or .Address(0, 0) = "D1" Then Cells(5, .Column).ClearContents Cells(8, .Column).ClearContents Cells(10, .Column).ClearContents End If End With End Sub

Hallo
hier mal eine Lösung, wo die deine Bereiche einfacher festlegen kannst.
Wichtig ist auch, dass vor beim Löschen von Zellen die Events ausgeschaltet werden (und nachher wieder ein)
Dieses Löschen ruft nämlich den Code erneut auf.
Bei einem möglichen Fehler sollte auch eine Fehlerbehandlung eingebaut sein, um die Events auf jeden Fall wieder einzuschalten


Private Sub Worksheet_Change(ByVal Target As Range)
Const APPNAME = "Worksheet_Change"
Dim RNG As Range
On Error GoTo Fehler
Set RNG = Union([B1], [B3])
If Not Intersect(RNG, Target) Is Nothing Then
Application.EnableEvents = False
If IsDate(Target) Then
Target.Offset(0, 2).ClearContents  'Zeilen versetzt / 2 Spalten versetzt // aus B wir D
Target.Offset(0, 5).ClearContents  'Zeilen versetzt / 5 Spalten versetzt // aus B wir G
Else
MsgBox Target & " ist kein gültiges Datum"
Application.Undo
End If
Application.EnableEvents = True
End If
'*** Fehlerbehandlung
Err.Clear
Fehler:
Application.EnableEvents = True
If Err.Number  0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _
& "Fehlernummer: " & Err.Number & vbLf & Err.Description: Err.Clear
End Sub

Private Sub Worksheet_Change(ByVal Target As Range) Const APPNAME = "Worksheet_Change" On Error GoTo Fehler If Target.Row > 1 Then ' Ggf wegen Überschrift If Not Intersect(Columns(2), Target) Is Nothing Then 'Nur Spalte B Application.EnableEvents = False If IsDate(Target) Then Target.Offset(0, 2).ClearContents 'Zeilen versetzt / 2 Spalten versetzt // aus B wir D 'weitere Zellen Target.Offset(0, 5).ClearContents 'Zeilen versetzt / 5 Spalten versetzt // aus B wir G Else MsgBox Target & " ist kein gültiges Datum" Application.Undo End If Application.EnableEvents = True End If End If '*** Fehlerbehandlung Err.Clear Fehler: Application.EnableEvents = True If Err.Number 0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _ & "Fehlernummer: " & Err.Number & vbLf & Err.Description: Err.Clear End Sub

Private Sub Worksheet_Change(ByVal Target As Range) Dim C As Range If Not Intersect(Target, Columns(2)) Is Nothing Then For Each C In Intersect(Target, Columns(2)) If C.Row Mod 2 = 1 Then If IsDate(C) Then Cells(C.Row, 4).ClearContents End If Next End If End Sub

Beliebteste Forumthreads (12 Monate)

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread