AW: Klarer
03.02.2006 14:51:34
Franz
Hallo Michael,
ich habe hier mal einen Anlauf genommen, eine entsprechende benutzerdefinierte Funktion zu schreiben. Die Feiertage und sonstige arbeitsfreien Tage werden dabei in eine separate Tabelle eingetragen und haben einen Bereichsnamen.
Die benutzerdefinierte Funktion kann sowohl direkt in der Tabelle verwendet werden als auch in einem Makro, das die Ergebnisse auf Basis der Taktzeiten berechnet und in die Tabelle einträgt.
Sub Taktzeiten()
' Ermittelt aus den Taktzeiten jeweils Taktende und Taktbeginn und trägt die Werte in die Tabelle
' Der Taktbeginn des 1. Taktes muß in der Tabelle vorgegeben werden!
Dim Daten As Range, Schichtbeginn As Date, Schichtende As Date
Set Daten = ActiveSheet.Range("A2:C" & ActiveSheet.UsedRange.Rows.Count)
Schichtbeginn = 8 / 24 'entspricht 08:00 Uhr
Schichtende = 18 / 24 ' entspricht 18:00 Uhr
For I = 1 To Daten.Rows.Count
Daten(I, 3) = Taktende(Daten(I, 1), Daten(I, 2), Schichtbeginn, Schichtende, Application.Range("Feiertage"))
If I < Daten.Rows.Count Then Daten(I + 1, 1) = Daten(I, 3)
Next I
End Sub
Function Taktende(Taktbeginn As Date, Taktzeit As Date, Schichtbeginn As Date, Schichtende As Date, Feiertage As Range) As Date
Dim Datum As Date, Arbeitstage As Integer, Restzeit As Date, Arbeitsfrei As Boolean
Dim I As Integer, J As Integer
Datum = Int(Taktbeginn) 'Datum des Taktbeginns
If Taktbeginn + Taktzeit <= Datum + Schichtende Then
'Takt wird am gleichen Tag vor Schichtende abgeschlossen
Taktende = Taktbeginn + Taktzeit
Exit Function
Else
'Takt wird an einem der folgenden Tage abgeschlossen
Restzeit = Taktzeit - (Datum + Schichtende - Taktbeginn)
' Arbeitstage für Restzeit
Arbeitstage = Int(Restzeit / (Schichtende - Schichtbeginn))
Taktende = Datum
For I = 0 To Arbeitstage
Taktende = Taktende + 1
Do
Arbeitsfrei = False
' Überprüfen auf Samstag oder Sonntag
If Application.WorksheetFunction.WeekDay(Taktende, 2) >= 6 Then
Arbeitsfrei = True
End If
' Überprüfen auf Feiertag
For J = 1 To Feiertage.Rows.Count
If Taktende = Feiertage(J, 1) Then
Arbeitsfrei = True
Exit For
End If
Next J
If Arbeitsfrei = True Then Taktende = Taktende + 1
Loop Until Arbeitsfrei = False
Next
Restzeit = Restzeit - Arbeitstage * (Schichtende - Schichtbeginn)
Taktende = Taktende + Restzeit + Schichtbeginn
End If
End Function
Als Hilfe hier eine kleine Beispiel-Datei mit den Makros:
https://www.herber.de/bbs/user/30628.xls
Gruß
Franz