20.04.2016, 07:44
Hallo,
wie wäre es, das Makro Step by Step durchlaufen zu lassen und zu prüfen, wann da 16:00 eingetragen wird und das dann auf 8:00Uhr zu ändern?? Sind genau 4Ziffern die geändert werden müssen!!!!
Habe gerade noch einen gravierenden Fehler gefunden und korrigiert:
wie wäre es, das Makro Step by Step durchlaufen zu lassen und zu prüfen, wann da 16:00 eingetragen wird und das dann auf 8:00Uhr zu ändern?? Sind genau 4Ziffern die geändert werden müssen!!!!
Habe gerade noch einen gravierenden Fehler gefunden und korrigiert:
Code:
Option Explicit
Sub Ueberstunden()
Dim loletzte As Long
Dim loZe As Long
Dim loa As Long
Dim wksQ As Worksheet
Dim wksZ As Worksheet
Set wksQ = Sheets("ZK")
Set wksZ = Sheets("MDL")
loletzte = Application.Max(wksZ.Cells(Rows.Count, 2).End(xlUp).Row + 1, 7)
If wksQ.Range("P10") <> Month(Date) Then
MsgBox "Falscher Monat!"
Exit Sub
End If
Application.ScreenUpdating = False
With wksQ
For loa = 16 To Application.Min(31, Day(Date) + 15)
If (.Cells(loa, 4) < 1 / 3) And (.Cells(loa, 4) <> "") Then
If MsgBox("Beginn am " & .Cells(loa, 2) & " vor 8:00Uhr. Als Überstunden speichern?", vbYesNo) = vbYes Then
wksZ.Cells(loletzte, 2) = .Cells(loa, 2)
wksZ.Cells(loletzte, 3) = .Cells(loa, 4)
wksZ.Cells(loletzte, 5) = .Cells(loa, 2)
wksZ.Cells(loletzte, 6) = 1 / 3
loletzte = loletzte + 1
.Cells(loa, 4) = 1 / 3
End If
End If
If .Cells(loa, 6) > 2 / 3 Then
If MsgBox("Ende am " & .Cells(loa, 2) & " nach 16:00Uhr. Als Überstunden speichern?", vbYesNo) = vbYes Then
wksZ.Cells(loletzte, 3) = 2 / 3
wksZ.Cells(loletzte, 2) = .Cells(loa, 2)
wksZ.Cells(loletzte, 5) = .Cells(loa, 2)
wksZ.Cells(loletzte, 6) = .Cells(loa, 6)
loletzte = loletzte + 1
.Cells(loa, 6) = 2 / 3
End If
End If
Next
If Day(Date) > 16 Then
For loa = 16 To Application.Min(30, Day(Date) - 1)
If (.Cells(loa, 14) < 1 / 3) And (.Cells(loa, 14) <> "") Then
If MsgBox("Beginn am " & .Cells(loa, 12) & " vor 8:00Uhr. Als Überstunden speichern?", vbYesNo) = vbYes Then
wksZ.Cells(loletzte, 2) = .Cells(loa, 12)
wksZ.Cells(loletzte, 3) = .Cells(loa, 14)
wksZ.Cells(loletzte, 5) = .Cells(loa, 12)
wksZ.Cells(loletzte, 6) = 1 / 3
loletzte = loletzte + 1
.Cells(loa, 14) = 1 / 3
End If
End If
If .Cells(loa, 16) > 2 / 3 Then
If MsgBox("Beginn am " & .Cells(loa, 12) & " nach 16:00Uhr. Als Überstunden speichern?", vbYesNo) = vbYes Then
wksZ.Cells(loletzte, 2) = .Cells(loa, 12)
wksZ.Cells(loletzte, 3) = 2 / 3
wksZ.Cells(loletzte, 5) = .Cells(loa, 12)
wksZ.Cells(loletzte, 6) = .Cells(loa, 16)
loletzte = loletzte + 1
.Cells(loa, 16) = 2 / 3
End If
End If
Next
End If
End With
With wksZ
For loa = 7 To loletzte - 1
If .Cells(loa, 8) = "" Then .Cells(loa, 8) = Application.Max(0, 1 / 3 - .Cells(loa, 3)) + Application.Max(0, .Cells(loa, 6) - 2 / 3)
Next
.Range(.Cells(7, 2), .Cells(loletzte, 8)).Sort key1:=.Cells(7, 2), Order1:=xlAscending
End With
Application.ScreenUpdating = True
End Sub