AW: Urlaub in Monatsblätter eintragen
23.12.2021 16:35:49
Alwin
Hallo Peer,
da du bisher noch nicht reagiert hast, vermute ich mal du wartest auf einen Lösungsvorschlag, entsprechend deines Aufbaus. Yal hatte dir schon eine eigene und vor allem zeitgemäße Möglichkeit angeboten. Ich hoffe Yal ist mir nicht böse, wenn es wieder mal in meinen Fingern gejuckt hat und ich nicht wiederstehen konnte.
Vorgehensweise wäre in dem Beispiel Doppelklick auf Zelle (Urlaubsbeginn) in Spalte A der Zeile, welche in den entsprechenden Monat/Monaten übertragen werden soll.
In Modul des Tabellenblattes "Urlaub":
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim i As Long, j As Long, k As Long, l As Long, Monat As String, Monat2 As String, UTag As String, suchTag As Range
i = ActiveCell.Row
j = CDate(Cells(i, 2) - Cells(i, 1) + 1)
Monat = Format(CDate(ActiveCell), "mmmm")
Monat2 = Format(CDate(ActiveCell.Offset(0, 1)), "mmmm")
UTag = Format(CDate(ActiveCell), "dd")
With Sheets(Monat)
.Unprotect
Set suchTag = .Range("A:A").Find(CDbl(UTag), LookAt:=xlWhole)
If Not suchTag Is Nothing Then
If Format(CDate(Cells(i, 2)), "mmmm") = Format(CDate(Cells(i, 1)), "mmmm") Then
For k = 1 To j
.Cells(suchTag.Row + k - 1, 3) = "Urlaub"
Next k
Else
For k = 1 To .Cells(Rows.Count, 1).End(xlUp).Row - suchTag.Row + 1
.Cells(suchTag.Row + k - 1, 3) = "Urlaub"
Next k
l = j - k
With Sheets(Monat2)
.Unprotect
For k = 1 To l + 1
.Cells(k, 3) = "Urlaub"
Next k
.Protect
End With
End If
End If
.Protect
End With
End Sub
Nach Ausführung der Prozedur steht in der Spalte C Urlaub in den Zellen. Das kannst du dann nach Gusto dir entsprechend passend machen.
Gruß Uwe