Hallo Gast25455,
schon mal Danke für den Code und deine Hilfe. Dachte man läd sich die Tabelle+Code von der verlinkten Seite.
Habe einen ganz anderen Ansatz gewählt.
Im letzen Teil des Codes steht die Anweisung.
'Globale Variablen
Public datumB1 As Variant
Public zellenB4B10 As Variant
Public istSchaltjahr As Boolean
Private Sub Workbook_Open()
' Variablen deklarieren
Dim ws As Worksheet
Dim wsDeckblatt As Worksheet
Dim wsStudien As Worksheet
Dim rng As Range
Dim cell As Range
Dim i As Integer
' Variablen iterieren
Set ws = ThisWorkbook.Sheets("Deckblatt")
Set wsDeckblatt = ThisWorkbook.Sheets("Deckblatt")
Set wsStudien = ThisWorkbook.Sheets("Studien")
Set rng = ws.Range("B4:B10")
' Prüfen, ob Zelle B1 leer ist und ob alle Zellen B4, B5, B6, B7, B8, B9, B10 leer sind
If IsEmpty(ws.Range("B1").Value) And _
IsEmpty(ws.Range("B4").Value) And _
IsEmpty(ws.Range("B5").Value) And _
IsEmpty(ws.Range("B6").Value) And _
IsEmpty(ws.Range("B7").Value) And _
IsEmpty(ws.Range("B8").Value) And _
IsEmpty(ws.Range("B9").Value) And _
IsEmpty(ws.Range("B10").Value) Then
MsgBox "Bitte tragen Sie ein Datum in Zelle B1 und die Namen der Studie ein. Speichern Sie die Änderung. Schließen Sie die Arbeitsmappe und öffnen Sie die Arbeitsmappe wieder, damit die Änderungen übernommen werden."
End If
' Prüfen, ob in Zelle B1 eine Zahl steht
If IsNumeric(ws.Range("B1").Value) Then
' Jahr gefunden, Ergebnis in globaler Variable und Zelle C1 speichern
datumB1 = CInt(ws.Range("B1").Value)
ws.Range("C1").Value = datumB1
' Prüfen, ob das Jahr ein Schaltjahr ist
istSchaltjahr = False
If (datumB1 Mod 4 = 0 And datumB1 Mod 100 <> 0) Or datumB1 Mod 400 = 0 Then
istSchaltjahr = True
End If
ws.Range("E1").Value = istSchaltjahr
End If
' Prüfen, ob in den Zellen B4:B10 etwas eingetragen ist
For Each cell In rng
i = cell.Row - 3
On Error Resume Next ' Falls das Arbeitsblatt nicht existiert, wird der Fehler ignoriert
If Not IsEmpty(cell.Value) Then
' Inhalt gefunden, Ergebnis in globaler Variable und Zelle D1 speichern
zellenB4B10 = zellenB4B10 & " " & cell.Address
ws.Range("D1").Value = zellenB4B10
' Das entsprechende Arbeitsblatt einblenden
ThisWorkbook.Sheets("Studie_" & i).Visible = True
Else
' Wenn die Zelle leer ist, das entsprechende Arbeitsblatt ausblenden
ThisWorkbook.Sheets("Studie_" & i).Visible = False
End If
On Error GoTo 0 ' Fehlerbehandlung zurücksetzen
Next cell
Set wsStudien = ThisWorkbook.Sheets("Studien")
' Wert aus Zelle D1 holen
zellenB4B10 = wsDeckblatt.Range("D1").Value
' Überprüfen, ob der Wert leer ist
If IsEmpty(zellenB4B10) Then
' Zeilen im Worksheets "Studien" ausblenden
For i = 1 To 7
wsStudien.Rows(i + 7).EntireRow.Hidden = True
Next i
Else
' Zeilen im Worksheet "Studien" einblenden
Dim zellen As Variant
zellen = Split(zellenB4B10, " ")
For Each zelle In zellen
If zelle <> "" Then
i = Right(zelle, 1) - 3
wsStudien.Rows(i + 7).EntireRow.Hidden = False
End If
Next zelle
End If
End Sub
|