Datumsformat in vba verwenden

Question

Guten Tag, wie kann ich dieses Datumsformat TTTT  TT. MMMM JJJJ in meinem code einbauen. Danke

Sub Datum()
Dim x As Long, Such As Date
Such = DateValue(Date)
Do Until Year(Such) <> Year(Date)
On Error Resume Next
x = Range("B:B").Find(Such, LookIn:=xlValues, lookat:=xlWhole).Row  'in Spalte B zu HEUTE oder zum LETZTEN Datum springen
On Error GoTo 0
If x > 0 Then Exit Do
Such = Such - 1
Loop
If x > 0 Then Cells(x, 1).Select
    'MsgBox "Das Datum " & Date & " ist in dieser Tabelle nicht vorhanden.", vbCritical, "Achtung wichtiger Hinweis !!!"
End Sub

Answer 1

Sub Datum()
    Dim r As Range, letzteZeile As Long
    Columns(2).NumberFormatLocal = "TTTT TT. MMMM JJJJ"
    letzteZeile = Cells(Rows.Count, 2).End(xlUp).Row
    Set r = Range("B1:B" & letzteZeile).Find(What:=CLng(Date), LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlPrevious)
    If r Is Nothing Then Set r = Range("B1:B" & letzteZeile).Find(What:="<" & CLng(Date), LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlPrevious)
    If Not r Is Nothing Then r.Offset(0, -1).Select
End Sub

Answer 2

Hallo,
bei mir geht: 

MsgBox "Das Datum " & Format(Date, "yyyy-mm-dd") & " ist in dieser Tabelle nicht vorhanden.", vbCritical, "Achtung wichtiger Hinweis !!!"

Answer 3

Sub Datum()
    Dim r As Range, letzteZeile As Long
    Columns(2).NumberFormatLocal = "TTTT TT. MMMM JJJJ"
    letzteZeile = Cells(Rows.Count, 2).End(xlUp).Row
    Set r = Range("B1:B" & letzteZeile).Find(What:=CLng(Date), LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlPrevious)
    If r Is Nothing Then Set r = Range("B1:B" & letzteZeile).Find(What:="<" & CLng(Date), LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlPrevious)
       If Not r Is Nothing Then
        r.Offset(0, -1).Select
        MsgBox "Gefundenes Datum: " & Format(r.Value, "dddd dd. mmmm yyyy"), _
        vbInformation, "Ergebnis"
    Else
        MsgBox "Das Datum " & Format(Date, "dddd dd. mmmm yyyy") & " ist in dieser Tabelle nicht vorhanden.", vbCritical, "Achtung!"
    End If
End Sub

Answer 4

Hallo an meine Helfer, ich habe mich wohl nicht richtig ausgedrückt, ich habe in Spalte (B4 bis B37) ein Datum mit dem Format (TTTT TT. MMMM JJJJ) es soll mit meinem code zum heutigen Datum in Spalte G springen. Danke

Sub Datum()
Dim x As Long, Such As Date
Such = DateValue(Date)
Do Until Year(Such) <> Year(Date)
On Error Resume Next
x = Range("B:B").Find(Such, LookIn:=xlValues, lookat:=xlWhole).Row  'in Spalte B zu HEUTE oder zum LETZTEN Datum springen
On Error GoTo 0
If x > 0 Then Exit Do
Such = Such - 1
Loop
If x > 0 Then Cells(x, 7).Select
    'MsgBox "Das Datum " & Date & " ist in dieser Tabelle nicht vorhanden.", vbCritical, "Achtung wichtiger Hinweis !!!"
End Sub