VBA automatisch zu heutigem Datum springen

[klaasen82]

Hallo alle zusammen,

ich habe ein Anliegen bezüglich eines Arbeitsplans, den ich zur Einteilung von Personal verwende.
Es sind im Grunde nur Tabellen untereinander, obendrüber immer das aktuelle Datum. Nun versuche ich vergeblich via VBA ein Makro zu erstellen mit dem man per Schaltflächen-Klicken auf den aktuellen Tag springt. Egal in welcher Registerkarte man sich befindet. Fortschritte mache ich hierbei leider nicht..

Ich habe mal eine Beispieldatei angefügt mit Erklärung.

Ich hoffe es kann mir jemand helfen. :(

Besten Dank im Voraus!


Freundliche Grüße

[Stoffo]

Hallo,

die Datei fehlt.

[UweD]

Hallo

angenommen deine Datumspalte wäre A


in ein Modul, was du einem Butten auf jedem Blatt zuordnen kannst

Code:

Sub Datum()
    Dim TB As Worksheet, Zeile As Long, SP As Integer
    Dim WF
   
    Set TB = ActiveSheet
    SP = 1 ' Datum steht in Spalte A
    Set WF = WorksheetFunction
    Zeile = WF.CountIf(TB.Columns(SP), Date) 'Ist Datum vorhande
   
    If Zeile > 0 Then
        Zeile = WF.Match(CDbl(Date), TB.Columns(SP), 0) 'in Welcher Zeile
        Application.Goto TB.Cells(Zeile, SP), True 'True = Es wird hingescrollt; False = Es wird nur ausgewählt
    End If
End Sub

LG UweD

[klaasen82]

Ich habe die Datei erneut angehangen! Danke für den Hinweis!

[klaasen82]

Das funktioniert in der Registerkarte selber schon einmal toll! Allerdings nicht, wenn das Datum in einer anderer Registerkarte liegt. Gibt es hierfür auch eine Lösung?

[UweD]

per Schaltflächen-Klicken auf den aktuellen Tag springt. Egal in welcher Registerkarte man sich befindet. 

Hallo
Ich hatte das so verstanden, dass egal auf welchem Blatt du dich befindest, die Zeile Dieses Blattes markiert werden sollte.





dann so...

Code:

Sub Datum()
    Dim TB As String, Datum As Date, Zeile As Integer
    Datum = DateSerial(Year(Date) + 1, Month(Date), Day(Date))
   
    TB = Format(Date, "MMM")
    Zeile = WorksheetFunction.Match(CDbl(Datum), Sheets(TB).Columns(1), 0)
    Application.Goto Sheets(TB).Cells(Zeile, 1), True
End Sub

LG UweD

[schauan]

Hallöchen,

oder so:

Code:

Sub tester()
Sheets(Format(Date, "MMM")).Activate
Cells(WorksheetFunction.Match(CDbl(Date), Columns(1), 0), 1).Activate
End Sub

mit dem man per Schaltflächen-Klicken auf den aktuellen Tag springt.

... ohne Prüfung, ob Datum existiert. Da Deine Beispieldatei 2021 beinhaltet, würde das heute nicht gehen. Morgen und übermorgen auch nicht. Wird wohl noch ein paar Tage dauern

[klaasen82]

Beide Varianten haben funktioniert. Habe das Datum von Windows als Test einfach einmal manuell geändert.
Nun tritt aber folgendes Problem mit einem Mal auf, wenn ich das Makro auslöse:

Fehler:
"die match-eigenschaft des worksheetfunction-objektes kann nicht zugeordnet werden"

Ich habe nicht an der Mappe gearbeitet oder etwas geändert.
Hat dazu jemand eine Lösung?

[UweD]

Hallo

dann gibt es auf dem Blatt in der Spalte A das Datum nicht.


Mit Prüfung:

Code:

Sub Datum()
    Dim TB As String, Datum As Date, Zeile As Integer
    Datum = Date
   
    TB = Format(Date, "MMM")
    If WorksheetFunction.CountIf(Sheets(TB).Columns(1), CDbl(Datum)) = 0 Then
        MsgBox Datum & " auf Blatt '" & TB & "' nicht vorhanden!"
    Else
        Zeile = WorksheetFunction.Match(CDbl(Datum), Sheets(TB).Columns(1), 0)
        Application.Goto Sheets(TB).Cells(Zeile, 1), True
    End If
End Sub

LG UweD

[klaasen82]

Mein Fehler, hab das Datum im falschen Blatt gehabt. Komplette Blödheit von meiner Seite.

Unfassbar, es klappt. Vielen Dank!!