VBA Gültigkeit Datum

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("A:B")) Is Nothing Then If ActiveCell.Value "" And ActiveCell.Offset(-1, 0) "" Then If ActiveCell.Value ActiveCell.Offset(-1, 0).Value + 1 Then MsgBox "Fehler": ActiveCell. _ ClearContents: End End If End If End Sub

Hallo Matthias,
eine Kleinigkeit müßte noch anders sein.
Im Moment wird die aktive Zelle nach Fehlerhafter Eingabe gelöscht, also nicht die in der die falsche Eingabe steht. (nach Eingabe und Return steht der Cursor eine Zelle weiter unten)
Ich habe versucht den Code anzupassen, funktioniert aber nicht.


Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A:B")) Is Nothing Then
If ActiveCell.Value  "" And ActiveCell.Offset(-1, 0)  "" Then
If ActiveCell.Value  ActiveCell.Offset(-1, 0).Value + 1 Then MsgBox "Fehler": ActiveCell. _
ClearContents: End
End If
End If
End Sub

'was bewirkt eigentlich folgender Teil, ich verstehe: (wenn Inhalt aktiver Zelle größer ist als Inhalt der Zelle darüber +1 dann "Fehler" und Inhalt aktiver Zelle löschen), ergibt für mich keinen Sinn?
If ActiveCell.Value > ActiveCell.Offset(-1, 0).Value + 1 Then MsgBox "Fehler": ActiveCell. _
ClearContents: End
Ich habe noch ein ähnliches Problem, dass man mit einem ähnlichem Code lösen könnte:
WENN folgende Formel erfüllt ist,
=WENN(ODER(UND(N6"");UND(O6>0;AF6="");UND(O6>0;AG6);
UND(Q6"");UND(R6>0;AF6="");UND(R6>0;AG6);
UND(T6"");UND(U6>0;AF6="");UND(U6>0;AG6);
UND(W6"");UND(X6>0;AF6="");UND(X6>0;AG6);
UND(Z6"");UND(AA6>0;AF6="");UND(AA6>0;AG6);
UND(AC6"");UND(AD6>0;AF6="");UND(AD6>0;AG6);
UND(AI6"");UND(AJ6>0;AL6="");UND(AJ6>0;AM6);
UND(AO6"");UND(AP6>0;AU6="");UND(AP6>0;AV6);
UND(AR6"");UND(AS6>0;AU6="");UND(AS6>0;AV6);
UND(AX6"");UND(AY6>0;BD6="");UND(AY6>0;BE6);
UND(BA6"");UND(BB6>0;BD6="");UND(BB6>0;BE6);
UND(BG6"");UND(BH6>0;BS6="");UND(BH6>0;BT6);
UND(BJ6"");UND(BK6>0;BS6="");UND(BK6>0;BT6);
UND(BM6"");UND(BN6>0;BS6="");UND(BN6>0;BT6);
UND(BP6"");UND(BQ6>0;BS6="");UND(BQ6>0;BT6));"Fehlermeldung";"")
dann soll nur ein Fenster mit der Meldung "neuer Fehler" erscheinen. (keine Zellinhalte löschen),
sonst (wenn die Formel nicht erfüllt ist) soll nichts passieren.
Der Code soll alle in der Formel stehenden Zellen (bzw. Spalten) ab Zeile 6 überwachen. In Zeile 1 in den entsprechenden Spalten steht allerdings etwas drin?!
Kannst du mir noch weiterhelfen?
Danke vielmals
Grüße aus Berlin

Hallo Peter,
so springt die Erfassung in die fehlerhafte Zelle zurück - zur korrigierten Eingabe:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
   If Not Intersect(Target, Range("A6:B65536")) Is Nothing Then
      If Target.Value <> "" And Target.Offset(-1, 0) <> "" Then
         If Target.Value < Target.Offset(-1, 0).Value Then _
            MsgBox "Fehler, das Datum ist kleiner !", _
               48, "   Hinweis für " & Application.UserName: _
            Target.ClearContents: Target.Select: End
         If Target.Value > Target.Offset(-1, 0).Value + 1 Then _
            MsgBox "Fehler, das Datum ist zu groß !", _
               48, "   Hinweis für " & Application.UserName: _
            Target.ClearContents: Target.Select: End
       End If
    End If
End Sub

Gruß Peter aus HH

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread