Schichtfolge berechnen

Da die Berechnung der Schichtfolge, wie ich sie auf der Seite Schichtfolge dargestellt habe, nicht so leicht zu verstehen ist, habe ich noch eine zweite Methode entwickelt. Das Grundprinzip ist zwar das gleiche, aber die Darstellung mehrerer Schichten ist so einfacher geworden, weil die Berechnung der Ausgeleichwerte weggefallen ist. Kernstück dieser Methode ist ebfalls die Berechnung eines Schlüsselwertes aus dem Datum. Wie die Formel Rest funktioniert, habe ich auf der Seite Formellösung detailiert beschrieben.

In den Spalten C bis F sind die Schichten der Schichten 1 (A) bis 4 (D) so eingetragen, wie sie auf bestimmte Tage gefallen sind. Das zugrunde gelegte Datum ist dabei beliebig auswählbar, es muß nur die eingetragene Schicht dazu passen. Im vorliegenden Beispiel haben wir eine Schichtfolge, die sich alle 28 Tage wiederholt. Deshalb wird in der Spalte B aus dem Datum in der Saplte A der Schlüsselwert mit der Funktion Rest berechnet. Da sich hinter dem Datum eine serielle Zahl verbirgt bekommen wir für jeden Tag ein anderes Ergebnis. Wegen der Division durch 28 sind das die Zahlen von 0 bis 27.

Diese Berechnungen sind die Basis für die Funktion VLookup (SVerweis). Damit wird passend zu jedem Datum der Suchbegriff ermittelt. Zuständig dafür ist dieser Teil des Makro:

Sub schichten()
' trägt vorgegebene Schichtkürzel in einen Kalender ein 
' geschrieben von Klaus-Dieter Oppermann 
' am 16.03.2004 
' Änderung 28.11.2004           ' Korrektur für Schaltjahr zugefügt 
' Änderung 28.10.2006           ' geänderte Ausgabe der Halbjahre 
' Änderung 24.01.2010           ' Berechnung der Schichtkürzel geändert (VLookup) 
' Variablen deklarieren 
Dim s As Integer                ' Schleifenzähler für Tabellenzeilen 
Dim we As Integer               ' Zuweisungsschlüssel 
Dim sp As Integer               ' Schleifenzähler für Spalten 
Dim arr(50, 0)                  ' Array zum Eintragen der Kürzel 
Dim ziel As Integer             ' letzte Zelle für Array 
Dim iHalbj                      ' Halbjahr 
Dim iZei As Integer             ' Zeilenbezug Zielzeile 
Dim iSta As Integer             ' Zeilenbezug Startzeile 
Dim Schi As Integer             ' Arrayfeld für Schichtkorrektur 
Dim intZieWe As Integer         ' Länge der Schichtfolge 
intZieWe = Application.WorksheetFunction.Max(Sheets("Schichtfolge").Range _
("B2:B" & Sheets("Schichtfolge").Range("B1").End(xlDown).Row)) + 1              ' Länge der Schichtfolge ermitteln 
iZei = 37                                                                       ' Zielzeile definieren 
iSta = 6                                                                        ' Startzeile definieren 
' Suchspalten für VLookup (SVerweis) festlegen 
Select Case Sheets("Kalender").Cells(3, 1)                                      ' Gewählte Schicht ermitteln 
    Case "Schicht 1"                                                            ' Wenn Schicht A, dann ... 
        Schi = 2                                                                ' ... Spaltenindex 2 
    Case "Schicht 2"                                                            ' wenn Schicht B, dann ... 
        Schi = 3                                                                ' ... Spaltenindex 3 
    Case "Schicht 3"                                                            ' wenn Schicht C, dann ... 
        Schi = 4                                                                ' ... Spaltenindex 4 
    Case "Schicht 4"                                                            ' wenn Schicht D, dann ... 
        Schi = 5                                                                ' ... Spaltenindex 5 
End Select                                                                      ' Ende der Festlegung 
' Kürzel in Kalender schreiben 
For iHalbj = 1 To 2                                                             ' Halbjahr definieren 
    If iHalbj = 2 Then                                                          ' wenn 2. Halbjahr, dann ... 
        iZei = 71                                                               ' ... Zielzeile ändern 
        iSta = 41  '40                                                          ' ... Startzeile ändern 
    End If                                                                      ' Ende 
    For sp = 2 To 17 Step 3                                                     ' Schleife für Spaltenzuweisung 
        ziel = Sheets("Kalender").Cells(iSta, sp - 1).End(xlDown).Row           ' Zielwert für Schleife 
        For s = 0 To ziel - iSta                                                ' Schleife für Einträge in Zeilen 
            we = Sheets("Kalender").Cells(s + iSta, sp - 1) Mod intZieWe        ' Feldwert für Variable berechnen 
            arr(s, 0) = Application.WorksheetFunction.VLookup(we, Sheets _
            ("Schichtfolge").Range("B2:H" & Sheets("Schichtfolge").Range("B1") _
            .End(xlDown).Row), Schi, False)                                     ' Neue Inhalte in Array einlesen 
        Next s                                                                  ' Schleifenzähler (Zeile) plus 1 
        Range(Sheets("Kalender").Cells(iSta, sp), Sheets("Kalender") _
        .Cells(ziel, sp)) = arr                                                 ' Array in Tabelle schreiben 
        Erase arr                                                               ' Array löschen 
    Next sp                                                                     ' Schleifenzähler (Spalte) plus 1 
    If Cells(1, 4) Mod 4 <> 0 Then Sheets("Kalender").Cells(34, 5) = ""         ' Korrektur für Schaltjahr 
Next iHalbj
End Sub