Microsoft Excel

Herbers Excel/VBA-Archiv

Springe zum heutigen Datum

Betrifft: Springe zum heutigen Datum von: Lisa
Geschrieben am: 03.09.2020 11:30:38

Hallo liebe VBA Freunde,


ich bräuchte mal wieder einen kleinen Hint - es ist mal wieder ganz simpel und liegt nur an dem Anwender ^^


Ich habe ein Excel Sheet mit einem Kalenderblatt.

In den Spaltenüberschriften stehen in Zeile 5, im Spaltenbereich AW bis KY, je ein Tagesdatum (also z.B. 03.09.2020).


Nun möchte ich bei einem Klick auf einen Button, dass er automatisch einfach in die Zelle springt, in der das heutige Datum steht. Mehr nicht.

Ich hab schon einiges ausprobiert und es hat nicht funktoniert.

Das Datum in den Spaltenüberschriften ist wie folgt definiert: TT.MMM.YY (also z.B. 03. Sep 20).


Ich danke euch schon mal!

Viele Grüße!

Betrifft: AW: Springe zum heutigen Datum
von: EtoPHG
Geschrieben am: 03.09.2020 11:45:46

Hallo Lisa,

Diesen Code in das Tabellenblatt mit dem Kalender:
Option Explicit

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Cancel = True
    On Error Resume Next
        UsedRange.Find(What:=Date).Select
    On Error GoTo 0
End Sub
Ein Rechtsklick in irgendeine (nicht gesperrte) Zelle löst den Sprung aus!

Gruess Hansueli

Betrifft: AW: Springe zum heutigen Datum
von: UweD
Geschrieben am: 03.09.2020 11:48:52

Hallo

in ein Modul
Sub datum()
    Dim RNG As Range, Sp As Integer
    
    Set RNG = ActiveSheet.Range("AW5:KY5")
    If WorksheetFunction.CountIf(RNG, CDbl(Date)) > 0 Then
        Sp = WorksheetFunction.Match(CDbl(Date), RNG, 0)
        Application.Goto RNG.Columns(Sp), True 'True= auch hinscrollen / False= nur selectieren
    End If
End Sub

LG UweD

Betrifft: AW: Springe zum heutigen Datum
von: Nepumuk
Geschrieben am: 03.09.2020 11:55:31

Hallo List,

einfach so:

Public Sub Schaltfläche1_Klicken()
    Application.Goto Cells(5, Application.Match(Clng(Date), Rows(5), 0))
End Sub

Gruß
Nepumuk

Betrifft: AW: Springe zum heutigen Datum
von: Lisa
Geschrieben am: 03.09.2020 12:51:26

Nepumuk! Vielen Dank! Das hat super funktioniert! :-)

Jetzt würde ich gerne noch die Zelle rot umrahmen (wenn sie angesprungen wird), damit man es gleich sieht und es soll sozusagen hinscrollen. Bei dem Code grade ist das Blatt noch nicht "mitgewandert".

Ich hab es so versucht, aber es läuft noch nicht ganz...:

ActiveCell.Select
Scroll = True
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent4
.TintAndShade = 0
.PatternTintAndShade = 0
End With

Betrifft: AW: Springe zum heutigen Datum
von: Nepumuk
Geschrieben am: 03.09.2020 12:59:47

Hallo Lisa,

teste mal:

Public Sub Schaltfläche1_Klicken()
    Application.Goto Cells(5, Application.Match(Clng(Date), Rows(5), 0)), True
    Rows(5).Interior.Pattern = xlPatternNone
    With ActiveCell.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent4
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End Sub

Gruß
Nepumuk

Betrifft: AW: Springe zum heutigen Datum
von: Lisa
Geschrieben am: 03.09.2020 13:17:51

Hallo Nepumuk,

zeigt er einen Laufzeitfehler 1004: Anwendungs- oder objektdefinierter Fehler

und sprint dann zur Stelle:

Rows(5).Interior.Pattern = xlPatternNone

Betrifft: AW: Springe zum heutigen Datum
von: Nepumuk
Geschrieben am: 03.09.2020 13:23:50

Hallo Lisa,

ersetze die Zeile:

Rows(5).Interior.Pattern = xlPatternNone

durch diese:

Range("AW5:KY5").Interior.Pattern = xlPatternNone

Gruß
Nepumuk

Betrifft: AW: Springe zum heutigen Datum
von: Lisa
Geschrieben am: 03.09.2020 13:27:43

Hallo Nepumuk,

es kommt nochmal der Fehler und springt wieder zur gleichen Stelle.
Muss ich hier evtl. noch etwas definieren? :-)

Betrifft: AW: Springe zum heutigen Datum
von: Nepumuk
Geschrieben am: 03.09.2020 13:28:46

Hallo Lisa,

sind die Zellen gesperrt (Blattschutz)?

Gruß
Nepumuk

Betrifft: AW: Springe zum heutigen Datum
von: Lisa
Geschrieben am: 03.09.2020 13:37:53

Hallo Nepumuk,

ja Blattschutz ist drin...

Betrifft: AW: Springe zum heutigen Datum
von: Nepumuk
Geschrieben am: 03.09.2020 13:42:25

Hallo Lisa,

versuch es so:

Public Sub Schaltfläche1_Klicken()
    Application.Goto Cells(5, Application.Match(Clng(Date), Rows(5), 0)), True
    ActiveSheet.Unprotect Password:="GEHEIM"
    Range("AW5:KY5").Interior.Pattern = xlPatternNone
    With ActiveCell.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent4
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    ActiveSheet.Protect Password:="GEHEIM"
End Sub

Das Kennwort musst du noch anpassen.

Gruß
Nepumuk

Betrifft: AW: Springe zum heutigen Datum
von: Lisa
Geschrieben am: 03.09.2020 13:37:55

Hallo Nepumuk,

ja Blattschutz ist drin...

Betrifft: AW: Springe zum heutigen Datum
von: Daniel
Geschrieben am: 03.09.2020 14:37:53

Hi
mach doch einfach eine Bedingte Formatierung für die Zellen AW5:KY5 mit der Regel: =AW5=Heute() und setze das Format auf rote Rahmenlinien.
Nachteil: damit gehen nur dünne Linien
Vorteil: du musst nichts programmieren und die ursprünglichen Linien wiederherstellen.
Solltest du einen Blattschutz haben, funktioniert das auch (nachdem du die Formatierung erstellt hast)

für das Sprungmakro würde ich folgenden Code verwenden, wenn dein Kalender lückenlos und aufsteigend sortiert ist:
With Range("AW5") 'erste Zelle des Kalenders
    ActiveWindow.ScrollColumn = .Column + Date - .Value
End with
da ein Datum in Excel eine normale Zahl ist, bei der ein Tag dem Wert 1 entspricht, kann man, wenn der Kalender lückenlos und aufsteigend sortiert ist (was Kalender in der Regel sind), die Zellposition eines bestimmten Datums einfach berechnen und muss dieses nicht suchen.
Lediglich bei Kalendern mit Lücken (z.B. nur Arbeitstage), unsortierten Datumswerten oder wenn die Datumwerte über mehrere Zeilen und mehrere Spalten verteilt sind, müsste man mit .FIND suchen, was aber bei Datumswerten in VBA ein paar Tücken hat.

Gruß Daniel

Betrifft: AW: Springe zum heutigen Datum
von: Lisa
Geschrieben am: 04.09.2020 11:21:52

Vielen, vielen Dank euch nochmal! Es funktioniert! :-)

Beiträge aus dem Excel-Forum zum Thema "Springe zum heutigen Datum"