Berechnungsmakro erweitern
mike49
bräuchte wieder mal Eure Hilfe.
In meinem Blatt "Arbeitszeitnachweis" wird der Arbeitsbeginn am Vormittag im Bereich E8:E38 sowie für den Nachmittag im Bereich G8:G38 eingetragen.
Das Makro ermöglicht, dass für die Berechnung der Arbeitszeit eine eingetragene Zeit vor 9:15 (Vormittag) bzw. 13:15 (Nachmittag) nicht berücksichtigt wird.
Nun möchte ich eine Änderung mit aufnehmen:
Es soll an Samstagen ab 9:00 gerechnet werden und eine eingetragene Zeit davor nicht berücksichtigt werden. Nachmittags wird nicht gearbeitet.
Bezug nehmen könnte man auf den Bereich D8:D38. Dort stehen die Wochentage in der Form So,Mo,Di usw. für den ganzen Monat. Die Einträge der Wochentage erfolgen automatisch.
Option Explicit
Function arbdau(va, ve, na, ne)
Dim vorm As Date
Dim nachm As Date
Dim ArbBegVM As Date 'Arbeitsbeginn Vormittag
Dim ArbBegNM As Date 'Arbeitsbeginn Nachmittag
Select Case ActiveSheet.Name
Case "Jan", "Feb", "Mär"
ArbBegVM = 9 / 24
ArbBegNM = 13 / 24
Case Else
ArbBegVM = 9.25 / 24
ArbBegNM = 13.25 / 24
End Select
'Anfangszeit VM prüfen
If va 0 And va > 0 Then vorm = ve - va
If ne > 0 And na > 0 Then nachm = ne - na
arbdau = vorm + nachm
End Function
Function nettobetr(stulo, netto)
If netto > 0 Then nettobetr = stulo * netto
End Function
Function arbdauger(va, ve, na, ne)
Dim vormGer As Double
Dim nachmGer As Double
If ve > 0 And va > 0 Then vormGer = Application.WorksheetFunction.Floor(ve * 24, ",25") _
- Application.WorksheetFunction.Ceiling(va * 24, ",25")
If ne > 0 And na > 0 Then nachmGer = Application.WorksheetFunction.Floor(ne * 24, ",25") _
- Application.WorksheetFunction.Ceiling(na * 24, ",25")
arbdauger = vormGer + nachmGer
End Function
Der geänderte Arbeitsbeginn für Jan, Feb und Mär soll noch gelten.
Es wäre schön, wenn jemand eine Lösung hätte.
Gruß
mike49