Anwesenheiten per VBA auszählen

[Gast 123]

Hallo Mario

ich hoffe das dein Makro laeuft, stelle aber noch ein Beispieldatei von mir ins Forum.  Sie war bereits fertig, hatte aber noch einen kleinen Fehler, den ich gerade behoben habe.  Mir fiel auf das mit den Summen evtl. etwas nicht stimmen könnte??  Prüfe es bitte selbst nach.

Es handelt sich um 44 Personen, multipliziert mit 8,5 Std. Arbeitszeit ergibt das bei mir 374 Stunden, nicht 440 Stunden wie in deinem neuen Code.  Was ich an deinem neuen Code auch nicht verstanden habe ist das weiterschreiben nach Halben Stunden?  Ich denke man muss die Zeiten der Anfangszeit wie im Blatt Belegstaerke zuordnen.  Liege ich da falsch??  Schau dir bitte einmal mein Beispiel an.  Entwickelt wurde das Makro für den Thread: Dienstplan.

mfg  Gast 123

[BoskoBiati]

Hallo,

da würde ich aber einiges ändern:

Code:

Option Explicit     
Dim ArBeginn As Double, ArEnde As Double, Std As Double, plus As Double
Dim beginn As Date, ze As Integer




Sub Stunden_ausrechnen()
Dim AC As Variant, QZ As Object
Dim ABZT As Worksheet, QS As Long
Dim BSTK As Worksheet, sp As Long
Dim loLastCol As Long
Dim loCol As Long
Dim rng As Range
Set ABZT = Sheets("Arbeitszeiten")
Set BSTK = Sheets("Besetzungsstärke")
loLastCol = ABZT.Cells(9, Columns.Count).End(xlToLeft).Column
'alte Belegungs Tabelle löschen
BSTK.Range("B4:AQ33").ClearContents
Application.ScreenUpdating = False
With ABZT
    sp = 5
        If .Cells(9, sp) <> "" Then
            For QS = 0 To 13    ' Bereich von QuellSpalte 5 bis 18
                loCol = QS * 3 + 2
                Set rng = .Range(.Cells(11, sp), .Cells(54, sp))
                For Each QZ In rng
                    Std = 0
                    If IsNumeric(Left(QZ, 1)) Then 'Zeiten berechnen bei Zeitangabe
                        ArBeginn = CDate(Left(QZ, 5))        'Start Zeit
                        ArEnde = CDate(Right(QZ, 5))  'Ende Zeit
                        plus = ArEnde - ArBeginn
                        If plus < 0 Then plus = plus + 1
                        Std = Round(plus * 24, 2) 'Dezimal Zeit
                    End If
                    beginn = Format(ArBeginn, "hh:mm"): ze = 0  'Beginn String
                    
                    ze = BSTK.Range("A3:A33").Find(beginn).Row
                    If ze = 0 Then MsgBox beginn & "  Uhrzeit nicht gefunden": Exit Sub
                    BSTK.Cells(ze, loCol) = BSTK.Cells(ze, loCol) + Std 'in gefundener Uhrzeit Stunden addieren
                Next QZ
                sp = sp + 1
            Next QS
        End If
End With
Application.ScreenUpdating = True
End Sub

Dann zählt es auch richtig! Es sind nämlich nur 367h, da von Z11 bis Z40 8,5 und danach nur jeweils 8h zu zählen sind!