18.01.2017, 10:21
Hallo
anbei ein geaendertes Makro. Am besten in ein neues Modulblatt kopieren und das alte zur Sicherheit bestehen lassen. Geaendert wurde auf Wunsch das die Stunden für Sa, So. nicht mehr berechnet werden, über die Variable Farbe. Die hat den Wert der Innenfarbe bei Sa., So., sonst ist sie Empty.
Den Urlaub ziehe ich jetzt auch direkt aus Spalte AH ab, mit Warnung wenn 0 erreicht ist, und eine zweite Schleife nach dem Stunden verarbeiten, um zu schauen wer unter einem Minimum liegt. Die Min Zahl steht in Const und lautet "Umin" zur Zeit auf 5 eingestellt. D.h., wer weniger als 5 Tage hat kommt eine Meldung zur Erinnerung das sein Urlaub zur Neige geht.
Die andere Sache muss ich mir noch anschauen, habe aber noch einen kniffligen Thread der mich ein paar Tage in Anspruch nimmt. Ob ich das auch noch lösen kann muss ich danach schauen. Ich hoffe das hilft schon mal weiter
mfg Gast 123
anbei ein geaendertes Makro. Am besten in ein neues Modulblatt kopieren und das alte zur Sicherheit bestehen lassen. Geaendert wurde auf Wunsch das die Stunden für Sa, So. nicht mehr berechnet werden, über die Variable Farbe. Die hat den Wert der Innenfarbe bei Sa., So., sonst ist sie Empty.
Den Urlaub ziehe ich jetzt auch direkt aus Spalte AH ab, mit Warnung wenn 0 erreicht ist, und eine zweite Schleife nach dem Stunden verarbeiten, um zu schauen wer unter einem Minimum liegt. Die Min Zahl steht in Const und lautet "Umin" zur Zeit auf 5 eingestellt. D.h., wer weniger als 5 Tage hat kommt eine Meldung zur Erinnerung das sein Urlaub zur Neige geht.
Die andere Sache muss ich mir noch anschauen, habe aber noch einen kniffligen Thread der mich ein paar Tage in Anspruch nimmt. Ob ich das auch noch lösen kann muss ich danach schauen. Ich hoffe das hilft schon mal weiter
mfg Gast 123
Code:
Option Explicit '6.1.2017 Gast 123 Clever Forum
'** 17.1.2017 auf Wunsch korrigiert
Const Umin = 5 'Warnung bei Urlaubstage < min.
'48=9,6 40=8 30=6 B=8 'U, K, WB noramle Zeit
Dim start As String, ende As String, Zeit As Long
Dim beginn As Date, xtime As Date, plus As Variant
Dim Nacht As Single, Stunden As Double, Std As Double
Dim Samstag As Single, Sonntag As Single, WS As Single
Dim Dienst As Integer, Farbe As Integer, Wert As Variant
Sub Stunden_ausrechnen()
Dim AC As Object, lz As Integer
Dim Zahl As Integer, i As Integer
lz = Range("B5").End(xlDown).Row
Range("AL5:AQ" & lz) = Empty
'1. Schleife zum auflisten aller Angestellten
For i = 0 To lz - 5
Stunden = Empty: Nacht = Empty: Dienst = Empty
Samstag = Empty: Sonntag = Empty: Std = Empty
'2. Schleife zum auflisten einer Person
For Each AC In Range("C5:AG5").Offset(i, 0)
If AC.Value = Empty Then GoTo weiter
Wert = AC.Value: Std = Empty: Farbe = Empty
'zuerst WS Wert laden und auswerten
WS = Cells(AC.Row, "AI").Value 'WS als Zahl laden
If WS = 48 Then Std = 9.6
If WS = 40 Then Std = 8
If WS = 30 Then Std = 6
If Wert = "B" Then Std = 8
'Zeiten berechnen bei Zeitangabe
If IsNumeric(Left(Wert, 1)) Then
start = Left(AC, 5) 'Beginn Zeit
ende = Trim(Mid(AC, 7, 15)) 'Endzeit
'korrektur wenn Minuten fehlen (unbedingt!!)
If InStr(ende, ":") = 0 Then ende = ende & ":00"
If InStr(start, ":") = 0 Then start = start & ":00"
xtime = CDate(ende) 'in Zeitformat wandeln
beginn = CDate(start)
'Zeit wenn Beginn kleiner als Endzeit ist
If beginn < xtime Then plus = xtime - beginn
'Zeit wenn Beginn grösserf als Endzeit ist
'über Differenz zu 24:00 Uhr berechnen
If beginn > xtime Then
Zeit = 24 - CInt(Left(start, 2))
If Right(start, 2) > 0 Then Zeit = Zeit - 1
beginn = CDate(Zeit & ":" & Right(start, 2))
plus = CDate(xtime + beginn)
End If
Std = Round(CDbl(plus * 24), 2) 'Dezimal Zeit
'Samstag, Sonntag und Nacht Auswerten
Farbe = Cells(4, AC.Column).Interior.ColorIndex
If Farbe = FSam Then Samstag = Samstag + Std
If Farbe = FSon Then Sonntag = Sonntag + Std
If Left(start, 2) > Left(ende, 2) Then Nacht = Nacht + Std
End If
'gesamt Stunden + Dienst addieren
'** 18.1.2017 Farbe, um Sam. Son. Std. nicht zu addieren
If Farbe = Empty Then Stunden = Round(Stunden + Std, 2)
Dienst = Dienst + 1
'** 18.1.2017 Urlaubstage von Spalte AH abziehen
If AC.Value = "U" Then
Zahl = Cells(AC.Row, "AH") 'Urlaubstage
Wert = Cells(AC.Row, "B") 'Mitarbeiter Name
If Zahl > 0 Then Cells(AC.Row, "AH") = Zahl - 1
If Zahl = 0 Then MsgBox Wert & " hat keinen Urlaub mehr - manuell korrigieren!"
End If
weiter:
Next AC
If Stunden > 0 Then
'Stunden Spalteen AL-AQ ausfüllen
Cells(i + 5, "AM") = Stunden 'Ist Stunden
Cells(i + 5, "AN") = Dienst 'Dienste
If Nacht > 0 Then Cells(i + 5, "AO") = Nacht 'Nacht
If Samstag > 0 Then Cells(i + 5, "AP") = Samstag 'Samstag
If Sonntag > 0 Then Cells(i + 5, "AQ") = Sonntag 'Sonntag
'Soll Stunden Spalte AL ausfüllen
If WS = 48 Then Cells(i + 5, "AL") = CDbl(Mid(Cells(1, 2), 9, 5))
If WS = 40 Then Cells(i + 5, "AL") = CDbl(Mid(Cells(2, 2), 9, 5))
If WS = 30 Then Cells(i + 5, "AL") = CDbl(Mid(Cells(3, 2), 9, 5))
End If
Next i
'** 2. Schleife zum Prüfen auf Urlaub Minimum
For i = 5 To lz
Wert = Cells(i, "B") 'Mitarbeiter Name
Zahl = Cells(i, "AH") 'Urlaubstage
'** 18.1.2017 Urlaubstage Minimum prüfen (ggf. Warnung)
If Zahl > 0 And Zahl < Umin Then
MsgBox Zahl & " Tage Rest Urlaub für Mitarbeiter: " & Wert
End If
Next i
'zum Prüfen Spalte "AM" setzen (** kann gelöscht werden)
Cells(5, "AM").Select
End Sub
![[-]](https://www.clever-excel-forum.de/images/collapse.png)