Keine Datumseingabe jünger als heute

[longjohnexcel]

Hallo Fans,
ich möchte über Datengültigkeitsabfrage nur Datumseingaben kleiner oder gleich heute zulassen, also keine Datumseingaben, die in der Zukunft liegen.
Wenn ich dann bei der Einstellung Datenüberprüfung bei Zulassen die Funktion "Datum" eingebe und bei Daten den Abgleich "kleiner oder gleich" sowie als Enddatum die Funktion "=("heute")" eingebe, gibt es die Fehlermeldung "Das für das Enddatum eingegebene Datum ist ungültig".
Was mache ich falsch bzw. kann ich als Enddatum überhaupt heute definieren?
Gibt es eventuell die Möglichkeit, morgen also heute plus einen Tag zu definieren und liegt darin die Lösung?
Danke für eure Hilfe.
Gruß   longjohn

[Peter]

Hallo,

Annahme: Die Werte sollen in A1 bis A10 eingegeben und geprüft werden.

Den Bereich A1 bis A10 markieren - Die Datenüberprüfung aufrufen - Zulassen: Benutzerdefiniert - Formel: =A1<=Heute() - OK

Beachte aber, dass damit eine Eingabe eines Datums in der Zukunft über C&P immer noch möglich ist.

[DbSam]

Hallo zusammen,


eine weitere Möglichkeit wäre:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Er
    Dim ErrorCount As Long
    
    If Intersect(Range("A1:A" & ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row), Target) Is Nothing Then Exit Sub
    
    Application.EnableEvents = False
    
    Select Case Target.Cells.Count
        Case 1
            If ActiveSheet.Cells(Target.Row, Target.Column) > Date Then
                MsgBox "Nur Datum 'kleiner gleich Heute' zulässig.", vbInformation, "Hinweis"
                ActiveSheet.Cells(Target.Row, Target.Column) = ""
            End If
        Case Else
            Dim i As Long
            For i = 0 To Target.Cells.Count - 1
                If ActiveSheet.Cells(Target.Row + i, Target.Column) > Date Then
                    ActiveSheet.Cells(Target.Row + i, Target.Column) = ""
                    ErrorCount = ErrorCount + 1
                End If
            Next i
            If ErrorCount > 0 Then
                MsgBox "Nur Datum 'kleiner gleich Heute' zulässig." & vbCrLf & _
                       "Es wurden nicht alle Daten übernommen.", vbInformation, "Hinweis"
            End If
    End Select
    
Ex:
    Application.EnableEvents = True
    Exit Sub
Er:
    Application.Cursor = xlDefault
    Application.EnableEvents = True
    Dim sErr As String
    sErr = "Fehlermeldung/Information..." & vbCrLf & vbCrLf
    sErr = sErr & "Fehlernummer: " & vbTab & Err.Number & vbCrLf & vbCrLf
    sErr = sErr & "Beschreibung: " & vbCrLf & Err.Description

    MsgBox sErr, vbCritical, "Sub: Worksheet_Change in Tabelle1"
    Resume Ex
    'For debug:
    Resume
End Sub

Hier werden Eingaben größer 'Heute' gelöscht und auch Fehleingaben über CopyPaste verhindert.
Den Code bei Deinem aktuellen Excelsheet hinterlegen und die Targetrange bitte anpassen. Im Moment reagiert diese auf Eingaben in Spalte A.

Dies ist nur als Beispiel gedacht und natürlich sehr verbesserungswürdig.




Gruß Carsten

[longjohnexcel]

Besten Dank an Euch alle. Gruß Hajo