hannsgmaulwurf
Goto Top

Excel Makro - Button "Springe zu Zeile mit heutigem Datum"

Hallo zusammen,

heute wende ich mich mal mit einer Excel Frage an euch. Es geht um Excel 2010 auf Windows 7.

Folgende Tabelle ist gegeben:

A B C D
1 Datum Artikel Rechnungsnr. Kaufpreis
2 23.04.2016 Laptop 0815 500,00 €
3 24.04.2016 Drucker 0816 100,00 €
4 25.04.2016 Maus 0817 50,00 €
5 26.04.2016 - €
2 27.04.2016 Tastatur 0818 10,00 €

Die Tabelle beinhaltet natürlich viel mehr Zeilen, wobei jede Zeile exakt einem Datum entspricht und jedes Datum nur einmal vorkommt.
Spalte A beginnt also irgendwann mit einem Startdatum, sagen wir mal den 01.01.2010 und dieses Datum läuft nach unten immer weiter.

Nun wollen wir gerne einen Button haben, auf den man klickt und automatisch in der Zeile mit dem aktuellen Datum landet.
In welcher Spalte man landet ist nicht sooo wichtig, wäre aber 'nice to have'.
Und die Zeile mit dem aktuellen Datum soll mittig angezeigt werden - also nicht als letzte sichtbare Zeile.

Folgendes habe ich (hier) gefunden:
=HYPERLINK("#A"&VERGLEICH(HEUTE();A:A);"zu heute")  
Das funktioniert auch, aber wir würden das doch gerne mit einem Button lösen.

Vielen Dank für eure Unterstützung!! face-smile

Content-Key: 302822

Url: https://administrator.de/contentid/302822

Printed on: April 18, 2024 at 23:04 o'clock

Member: colinardo
Solution colinardo Apr 25, 2016 updated at 13:51:05 (UTC)
Goto Top
Hallo lieber Maulwurf,
das gewünschte erreichst du z.B. hiermit
Sub JumpToday()
    Dim f As Range
    Set f = Range("A:A").Find(Date, LookIn:=xlValues)  
    If Not f Is Nothing Then f.EntireRow.Select
End Sub
Grüße Uwe
Member: hannsgmaulwurf
hannsgmaulwurf Apr 25, 2016 at 14:51:51 (UTC)
Goto Top
Hallo Uwe, vielen Dank, klappt face-smile
Member: hannsgmaulwurf
hannsgmaulwurf Apr 27, 2016 at 09:06:46 (UTC)
Goto Top
Wenn es jetzt noch möglich wäre, die Zeile, in der man sich gerade befindet, mit einem roten Rahmen zu versehen...

Ich habe schon das hier probiert, aber da wird dann die komplette Zeile markiert (.EntireRow) anstatt nur bspw. A3:D3 und ich kriege es nicht hin, anstatt der Hintergrundfarbe einen Rahmen zu erstellen.

Für einen VBA Crack ist das doch bestimmt eine leichte Übung, oder? face-smile
Member: colinardo
Solution colinardo Apr 27, 2016 updated at 17:14:31 (UTC)
Goto Top
Du meinst das im Zusammenhang mit dem obigen Code? Dann :
Sub FindCurrentDateInRangeAndColorRange()
    Dim f As Range
    Set f = Range("A:A").Find(Date, LookIn:=xlValues)  
    If Not f Is Nothing Then
        ' Bereich A:D der gefundenen Zeile mit einem roten Rahmen versehen.  
        Range("A" & f.Row, "D" & f.Row).BorderAround LineStyle:=XlLineStyle.xlContinuous, Weight:=xlMedium, Color:=vbRed  
    End If
End Sub
Oder du meinst es so dass die Markierung mit der aktuellen mit wandert:
'hält Buch über die letzte aktuelle Zeile  
Dim lastRange As Range

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.ScreenUpdating = False
    Dim rngMarker As Range
    ' Wenn der letzte Zeile farbig markiert wurde entferne die Markierung  
    If Not lastRange Is Nothing Then
        lastRange.Borders.LineStyle = xlLineStyleNone
    Else
        'letzter Bereich nicht gesetzt (z.B. beim Start von Excel), dann lösche alle Ränder des Bereichs  
        Range("A:D").Borders.LineStyle = xlLineStyleNone  
    End If
    ' Bereich der zu markierende Zellen der aktuellen Zeile festlegen  
    Set rngMarker = Range("A" & Target.Row, "D" & Target.Row)  
    ' Zellen mit roter Markierung versehen  
    rngMarker.BorderAround LineStyle:=XlLineStyle.xlContinuous, Weight:=xlMedium, Color:=vbRed
    ' aktuelle Zeile speichern  
    Set lastRange = rngMarker
    Application.ScreenUpdating = True
End Sub
Hier das Demo-Sheet zum Download dazu.

Tipp: Nutze mal den Makrorekorder, damit können Laien etwas schneller lernen face-smile

Grüße Uwe
Member: hannsgmaulwurf
hannsgmaulwurf May 09, 2016 at 06:55:04 (UTC)
Goto Top
Vielen vielen Dank für deine Hilfe und vor allem die ausführlichen Kommentare Uwe!! face-smile TOP!!
Mit dem Makrorekorder habe ich es auch schon versucht aber das kommt auf's gleiche raus als wenn ich mir Codes (wie deinen hier) von irgendwoher zusammen kopiere und per try&error anpasse face-smile Also nochmals vielen Dank!!