Überstunden von einem Arbeitsblatt in ein anderes übertragen

[BoskoBiati]

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:

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

[Erika]

Hallo Edgar,

ja ist eine gute Idee und funktioniert für diesen Bereich der Frühstunden (jedoch fehlt noch die 0 (06:00, Buchhaltungsvorgabe leider))
Ist das für die Abendstunden auch möglich 16:00 - 22:00 (da Vorgabe)

[
Bild bitte so als Datei hochladen: Klick mich!
]

Welchen Fehler hast du noch gefunden?? Du weist ja bin Code-Nackertbazerl :) 

Danke Erika

[BoskoBiati]

Hallo,

übernimm den Code aus dem vorherigen Post, da müsste alles passen!

[Erika]

Hallo Edgar,
danke funktioniert echt super. Tausend Dank. Wo kann ich noch entsprechend den VBA-Code ändern damit bei den Frühstunden noch die 0 dazukommt??   Danke Erika

[BoskoBiati]

?????????????????????