Schichtfolge berechnen
Anzeige mit VLookup (SVerweis)
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.
Schichtfolge | | A | B | C | D | E | F | | 1 | Datum | Schlüssel | 1 | 2 | 3 | 4 | | 2 | 01.01.2006 | 22 | N | S | F | - | | 3 | 02.01.2006 | 23 | - | N | S | F | | 4 | 03.01.2006 | 24 | - | N | S | F | | 5 | 04.01.2006 | 25 | F | - | N | S | | 6 | 05.01.2006 | 26 | F | - | N | S | | 7 | 06.01.2006 | 27 | S | F | - | N | | 8 | 07.01.2006 | 0 | S | F | - | N | | 9 | 08.01.2006 | 1 | S | F | - | N | | 10 | 09.01.2006 | 2 | N | S | F | - | | 11 | 10.01.2006 | 3 | N | S | F | - | | 12 | 11.01.2006 | 4 | - | N | S | F | | 13 | 12.01.2006 | 5 | - | N | S | F | | 14 | 13.01.2006 | 6 | F | - | N | S | | 15 | 14.01.2006 | 7 | F | - | N | S | | 16 | 15.01.2006 | 8 | F | - | N | S | | 17 | 16.01.2006 | 9 | S | F | - | N | | 18 | 17.01.2006 | 10 | S | F | - | N | | 19 | 18.01.2006 | 11 | N | S | F | - | | 20 | 19.01.2006 | 12 | N | S | F | - | | 21 | 20.01.2006 | 13 | - | N | S | F | | 22 | 21.01.2006 | 14 | - | N | S | F | | 23 | 22.01.2006 | 15 | - | N | S | F | | 24 | 23.01.2006 | 16 | F | - | N | S | | 25 | 24.01.2006 | 17 | F | - | N | S | | 26 | 25.01.2006 | 18 | S | F | - | N | | 27 | 26.01.2006 | 19 | S | F | - | N | | 28 | 27.01.2006 | 20 | N | S | F | - | | 29 | 28.01.2006 | 21 | N | S | F | - | | 30 | Ab hier wiederholt sich die Schichtfolge | |
|
| Formeln der Tabelle | | Zelle | Formel | | B2 | =REST(A2;28) | | B3 | =REST(A3;28) | | B4 | =REST(A4;28) | | B5 | =REST(A5;28) | | B6 | =REST(A6;28) | | B7 | =REST(A7;28) | | B8 | =REST(A8;28) | | B9 | =REST(A9;28) | | B10 | =REST(A10;28) | | B11 | =REST(A11;28) | | B12 | =REST(A12;28) | | B13 | =REST(A13;28) | | B14 | =REST(A14;28) | | B15 | =REST(A15;28) | | B16 | =REST(A16;28) | | B17 | =REST(A17;28) | | B18 | =REST(A18;28) | | B19 | =REST(A19;28) | | B20 | =REST(A20;28) | | B21 | =REST(A21;28) | | B22 | =REST(A22;28) | | B23 | =REST(A23;28) | | B24 | =REST(A24;28) | | B25 | =REST(A25;28) | | B26 | =REST(A26;28) | | B27 | =REST(A27;28) | | B28 | =REST(A28;28) | | B29 | =REST(A29;28) |
|
|
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 Spalte 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:
we = Sheets("Kalender").Cells(s + iSta, sp - 1) Mod intZieWe ' Feldwert für Variable berechnen
Die Variable intZieWe wird automatisch mit einem Wert versehen. Damit wird die Bedienung des Programms für die Anwender erleitert, weil
im Quelltext keine Änderungen mehr vorgenommen werden müssen. Der folgende Teil des Makro weist jedem Tag über ein Array das passende Schichtkürzel zu:
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
Über das Array erfolgen dann die Einträge im Kalender Monatsweise. Das spart einiges an Zeit.
Range(Sheets("Kalender").Cells(iSta, sp), Sheets("Kalender") _
.Cells(ziel, sp)) = arr ' Array in Tabelle schreiben
Abschließend das vollständige Makro, ich hoffe, damit die Bedienfreundlichkeit des Programms verbessert zu haben. Der Anwender
muß nur noch die Einträge auf der Seite Schichtfolge vornehmen, so wie es oben zu sehen ist. Wobei die Länge der Schichtfolge und die
Lage der einzelnen Schichten beliebig verändert werden können. Wenn mehr als vier Schichten benötigt werden, kann das realisiert werden, Anfragen dazu beantworte ich gerne.
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 Schichtkalender.ComboBox2.ListIndex ' Gewählte Schicht ermitteln
Case 0 ' Wenn Schicht A, dann ...
Schi = 2 ' ... Spaltenindex 2
Case 1 ' wenn Schicht B, dann ...
Schi = 3 ' ... Spaltenindex 3
Case 2 ' wenn Schicht C, dann ...
Schi = 4 ' ... Spaltenindex 4
Case 3 ' 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
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
Natürlich stelle ich auch diese Programm als fertige Datei zu Verfügung:
Programm herunter laden
Bisher mal herunter geladen.