Sub Schicht()
Dim StartSchicht As String
Dim dJahr As Integer
Dim dMonat As Integer
Dim dTag As Integer
Dim eTag As Integer
Dim LetzteZelle As String
Application.ScreenUpdating = False
dJahr = Application.InputBox(Prompt:="Welches Jahr?", Title:="Datum abfragen...", Type:=1)
dMonat = Application.InputBox(Prompt:="Welcher Monat?", Title:="Datum abfragen...", Type:=1)
StartSchicht = UCase(Application.InputBox(Prompt:="Welche Schicht am Monatsersten?", Title:="Schicht abfragen...", Type:=2))
Select Case StartSchicht
Case "A", "B", "C", "D"
Case Else
MsgBox "Die Eingabe " & StartSchicht & " ist keine korrekte Schichtbezeicnung!", vbCritical, "Fehler..."
Exit Sub
End Select
Range("$A:$A").EntireColumn.ColumnWidth = 11
Range("$B$2:$AF$20").ClearContents
Range("$B$2:$AF$20").EntireColumn.ColumnWidth = 3
If dMonat < 12 Then
eTag = Day(DateSerial(dJahr, dMonat + 1, 0))
Else
eTag = Day(DateSerial(dJahr + 1, 1, 0))
End If
For dTag = 1 To eTag
Cells(6, dTag + 1) = Format(DateSerial(dJahr, dMonat, dTag), "ddd") & Chr(10) & Format(DateSerial(dJahr, dMonat, dTag), "dd")
If dTag + 1 = 2 Then
Cells(7, dTag + 1) = StartSchicht
Else
Select Case Cells(7, dTag)
Case "C"
Cells(7, dTag + 1) = "B"
Case "B"
Cells(7, dTag + 1) = "A"
Case "A"
Cells(7, dTag + 1) = "D"
Case "D"
Cells(7, dTag + 1) = "C"
End Select
End If
Next dTag
Application.ScreenUpdating = True
End Sub
|