Datum in verschiedenen Tabellen suchen und anwählen

Question

Hallo guten Tag, eure Hilfe ist wieder gefragt. Ich habe in Excel 4 Tabellen Tabelle1 = Juli, Tabelle2 = August, Tabelle3 = September, Datum bei allen 3 Tabellen ab B2. Und Tabelle4 = Kalender, Datum von A2 Januar bis L33 Dezember. Nun soll, wenn ich z.B. in Tabelle4 auf Zelle G3 = 01.07 doppelklicke die Tabelle Juli öffnet und zum Datum 01.07 in Spalte ab B2 springt. Beispiel in Tabelle4 auf Zelle H14 = 12.08 doppelklicke die Tabelle August öffnet und zum Datum 12.08 in Spalte ab B2 springt usw.

Answer 1

Hallo Jelena,

stelle doch mal bitte eine Beispieldatei zur Verfügung. Wie du Dateien hochladen kannst, siehst du hier: Anleitung

Gruß

M.O.

Answer 2

Hallo M.O. hier eine Beispieldatei. Danke

Answer 3

Hallo Jelena,

kopiere den folgenden Code in das VBA-Projekt des Arbeitsblattes Kalender:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim i As Integer
Dim strName As String
Dim bExist As Boolean
Dim dDatum As Date
Dim lngZeile As Long

'Nur im Bereich des Kalenders Makro ausführen
If Not Intersect(Target, Range("A3:L33")) Is Nothing Then
   'nicht in Zelle klicken
   Cancel = True
   'Datum auslesen
   dDatum = Target.Value
     
   'Monat ermitteln und daraus Name der Tabelle, zu der gewechselt werden soll
   Select Case Month(dDatum)
      Case 1: strName = "Reservierung Januar"
      Case 2: strName = "Reservierung Februar"
      Case 3: strName = "Reservierung März"
      Case 4: strName = "Reservierung April"
      Case 5: strName = "Reservierung Mai"
      Case 6: strName = "Reservierung Juni"
      Case 7: strName = "Reservierung Juli"
      Case 8: strName = "Reservierung August"
      Case 9: strName = "Reservierung September"
      Case 10: strName = "Reservierung Oktober"
      Case 11: strName = "Reservierung November"
      Case 12: strName = "Reservierung Dezember"
   End Select
      
   'prüfen ob Tabelle in Arbeitsmappe vorhanden ist
   For i = 1 To ThisWorkbook.Worksheets.Count
      If Worksheets(i).Name = strName Then
        bExist = True
        Exit For
       End If
    Next i
    
    'Abbruch wenn Tabelle nicht existiert
    If bExist = False Then
      MsgBox "Die Tabelle " & strName & "existiert nicht! Abbruch", 16, "Fehler"
      Exit Sub
    End If
    
    'auf entsprechende Tabelle wechseln
    With Worksheets(i)
       .Activate
       'Datum suchen, dazu den Tag vergleichen
      For lngZeile = 3 To .Cells(Rows.Count, 1).End(xlUp).Row
         If IsEmpty(.Cells(lngZeile, 2)) = False And Day(.Cells(lngZeile, 2).Value) = Day(dDatum) Then
            .Cells(lngZeile + 1, 2).Select 'Zelle unter dem gefundenen Datum aktivieren
            Exit For
         End If
       Next lngZeile
     End With
End If

End Sub

Gruß

M.O.

Answer 4

Hallo M.O. ist es möglich dass das gefundene Datum ganz oben in der Tabelle erscheint, nach oben scrollen. Der Rest passt super. Danke

Answer 5

Hallo Jelena,

dann ergänze den letzten IF-Teil wie folgt:

 'auf entsprechende Tabelle wechseln
    With Worksheets(i)
       .Activate
       'Datum suchen, dazu den Tag vergleichen
      For lngZeile = 3 To .Cells(Rows.Count, 1).End(xlUp).Row
         If IsEmpty(.Cells(lngZeile, 2)) = False And Day(.Cells(lngZeile, 2).Value) = Day(dDatum) Then
            .Cells(lngZeile + 1, 2).Select 'Zelle unter dem gefundenen Datum aktivieren
            ActiveWindow.ScrollRow = ActiveWindow.ActiveCell.Row - 1
            Exit For
         End If
       Next lngZeile
     End With

Gruß

M.O.

Answer 6

Hallo M.O. einfach super. Danke