Anwesenheiten per VBA auszählen

[Mario]

  Zeiten Zählen.xlsm (Größe: 61,03 KB / Downloads: 18)
Hallo zusammen,

ich habe eine Datei von einem Kollegen geerbt, die jetzt komplett umgebaut wurde.
Leider habe ich bei einen Makro ein Problem und komme hier nicht wirklich weiter. 

Hierbei werden die Arbeitszeiten ausgelesen und eine Besetzungsstärke wird ermittelt.

Leider läuft das Makro beim Auszählen in folgender Zeile immer auf ein Fehler.

Code:

If Pr1 > #5:15:00 AM# + (HStd * AnZeit) And Pr1 < #5:45:00 AM# + (HStd * AnZeit) Then ' Abfrage des Arbeitsbeginnzeitraums
               ArBeginn = Left(Arbeitszeiten.Cells(QZ, QS), 5) ' Arbeitsbeginn
               ArEnde = Mid(Arbeitszeiten.Cells(QZ, QS), 7, 5) ' Arbeitsende

Eventuell kann mir ja einer von euch auf die Sprünge helfen.

Danke und VG Mario

[Käpt'n Blaubär]

Hallo,

Leider läuft das Makro beim Auszählen in folgender Zeile immer auf ein Fehler.

und wie lautet die Fehlermeldung?

[Mario]

Hallo,

die Fehlermeldung lautet:

"Laufzeitfehler 1004  Anwendungs-oder objektdefinierter Fehler"

VG Mario

[Ego]

Hallo Mario,

wie kommst du auf deine Fehlerzeile? Bei mir tritt der Fehler in dieser Zeile ein:

Code:

 If Besetzungsstaerke.Cells(Ze, sp) = "" Then Besetzungsstaerke.Cells(Ze, sp) = 0 ' Wenn keine entsprechende Anfangszeit, dann 0 eintragen

Ich weis nicht was das Programm macht und was seit der letzten lauffähigen Version geändert wurde, aber eine Spalte 0 kann Excel in Cells() nicht verarbeiten.

Für mich sieht es so aus, als ob eine Initialisierung von sp versehentlich gelöscht wurde.

[Mario]

Hallo Helmut,

ja das hast du Recht, ich sehe den Wald vor Bäumen schon nicht mehr  :40:

Habe den Code jetzt ergänzt.

Code:

Option Explicit

Public Besetzung As Boolean

Dim Lz_Bl1%, Ls_Bl1%, StartSp_Bl1%, Lz_Bl3%, Ls_Bl3%, Datum_Bl1 As Date, HStd As Date
Dim TBDatenSPX As Worksheet, Arbeitszeiten As Worksheet, Besetzungsstaerke As Worksheet

Sub AnwesenheitZaehlen()
Dim i%, QS%, QZ%, Ze%, sp%, AnZeit%
Dim Pr1, Pr2
Dim ArEnde As Date, ArBeginn As Date
Dim Arbeitszeiten As Worksheet
Dim Besetzungsstaerke As Worksheet
Dim Std As Date
Dim HStd As Date


Set Arbeitszeiten = Sheets("Arbeitszeiten")
Set Besetzungsstaerke = Sheets("Besetzungsstärke")
Std = Format("00:00", "hh:mm") ' Start Anfangszeit
HStd = Format("00:30", "hh:mm") ' 1/2 stündlich dazurechnen

For QS = 5 To 18    ' Bereich von QuellSpalte 5 bis 18
sp = 2 ' AnfangsSpalte Blatt 2 festlegen
Ze = 4 ' AnfangsZielZeile Blatt 2 festlegen

' Arbeitszeit von 06:00 bis 00:00 Uhr
' ------------------------------------
   For AnZeit = 2 To 33 ' Zeilen der Anfangszeiten (Besetzungsstärke) von 05:00 Uhr bis 20:00 Uhr
       For QZ = 11 To 54 ' Bereich von QuellZeile Blatt 1 bis LetzteQuellZeile Blatt 1
           

           Pr1 = Left(Arbeitszeiten.Cells(QZ, QS), 5) ' Die ersten 5 Zeichen auslesen ---- Zeitraum auslesen
           If Val(Pr1) = 0 Then GoTo weiter ' Wenn Text oder leer, dann weiter bei Next QZ

           If Pr1 > #5:15:00 AM# + (HStd * AnZeit) And Pr1 < #5:45:00 AM# + (HStd * AnZeit) Then ' Abfrage des Arbeitsbeginnzeitraums ab 06:00 Uhr bis 00:00 Uhr
               ArBeginn = Left(Arbeitszeiten.Cells(QZ, QS), 5) ' Arbeitsbeginn
               ArEnde = Mid(Arbeitszeiten.Cells(QZ, QS), 7, 5) ' Arbeitsende
               
               If ArEnde >= 0 And ArEnde < #7:01:00 AM# Then
                   Pr2 = ((HStd * 48) - ArBeginn) + ArEnde ' Ist Arbeitsende über 00:00 Uhr, dann (24 Sdt. - Arbeitsbeginn) + Arbeitsende
               Else
                   Pr2 = ArEnde - ArBeginn ' (Arbeitsende unter 00:00 Uhr) - Arbeitsbeginn
               End If
               
               Pr2 = Mid(CDate(Pr2) / HStd, 1, 5) ' Anzahl der 1/2 Stunden nach unten gerundet
               ' Fehlerabfrage, wenn keine richtige Arbeitszeit
               If Pr2 > 25 Or Pr2 < 0 Then
                   MsgBox "Es ist ein Fehler aufgetreten der auf einer falschen Arbeitszeit " & "in der Zeile " & QZ & " hinweist." & Chr$(13) & Chr$(13) & _
                       "Bitte den Fehler suchen und abändern und danach erneut auf 'Jetzt aktualisieren' drücken!", vbCritical, "Fehler Arbeitszeit"
                   
                   Exit Sub
               End If
               
               For i = Ze To Pr2 + Ze - 1 ' Anzahl der 1/2 Std. auf die entsprechenden Uhrzeiten verteilen
                 
                   If i < 313 Then
                       Besetzungsstaerke.Cells(i, sp) = 1 + Besetzungsstaerke.Cells(i, sp) ' Inhalt der Zelle + 1 hinzufügen
                   Else
                       Besetzungsstaerke.Cells(i - 48, sp + 3) = 1 + Besetzungsstaerke.Cells(i - 48, sp + 3) ' Inhalt der Zelle + 1 hinzufügen
                   End If
               Next i
           End If
weiter:
       Next QZ
       If Besetzungsstaerke.Cells(Ze, sp) = "" Then Besetzungsstaerke.Cells(Ze, sp) = 0 ' Wenn keine entsprechende Anfangszeit, dann 0 eintragen
     
       Ze = AnZeit + 4 ' (Zielzeile Blatt 2)+ Anfangszeile 4
   Next AnZeit

   sp = sp + 3 ' Wenn alle Zeilen durchlaufen, dann drei ZielSpalten Blatt 2 weiter



Next QS ' Nächste QuellSpalte Blatt 1 zum auslesen


End Sub

Bekomme jetzt den Fehler 51 in der Zeile:

Pr2 = Mid(CDate(Pr2) / HStd, 1, 5) ' Anzahl der 1/2 Stunden nach unten gerundet


LG Mario

[Ego]

Hallo Mario,

wenn du in dieser Zeile über den Debugger einen Haltepunkt setzt und beim Halt des Makros mit dem Curser die einzelnen Werte in der Zeile auswertest, erkennst du, dass Excel "CDate(Pr2) / HStd" nicht bearbeiten kann.
Warum kann ich dir im Augenblick auch nicht sagen, aber da eine halbe Stunde in VBA = 1/48 ist, kannst du "/ HStd" durch "*48" ersetzen.


noch drei Bemerkungen zu der Datei:

1) Die Initialisierung von "sp" sollte wohl vor der QS-Forschleife erfolgen.
2) Die Daten in den beiden Exceltabellen sollten wohl den gleichen Zeitraum umfassen.
3) Die Uhrzeiten in der Besetzungsstärke scheinen noch nicht zu passen.

[atilla]

Hallo zusammen,

bezüglich der letzten Fehlermeldung, kann es sein, dass in der besagten Zeile nicht 1,5 sonder 1.5 stehen müsste?

[Ego]

Hallo atilla,

die  "1 , 5" ist richtig da MID eine Stringfunktion ist, die drei Parameter benötigt.

Die Funktion macht aber nicht das, was in dem Kommentar geschrieben wird. Dafür müste der dritte Parameter 2 sein.
Das Ergebnis der Formel im ersten Parameter ist ein Datum (also eine Zahl) zwischen 0 und 48 eventuell mit Nachkommastellen.
Da MID aber im ersten Parameter einen String benötigt, wandelt sie die Zahl in eine Zeichenkette um.
Falls die Zahl zwei Vorkommastellen hat liefert MID diese, ansonsten die eine Vorkommastelle und ein Punkt.
Da PR2 durch die erste Zuweisung in VBA ein Datum ist, wird der von MID gelieferte Text ein ganzzahliges Datum.

Insgesamt ist dieses Programm eine furchtbare Nutzung der Typanpassungen in Excel.

[atilla]

Hallo Helmut,


ich hatte den Ausdruck CDate(Pr2) / HStd fälschlicherweise als zwei Parameter und nicht als eine Berechnung gesehen, dessen Ergebnis der erste Parameter für die Funktion Mid ist.

Nichts für ungut und danke für die weiteren Erläuterungen.

Nachtrag: habe mir jetzt das Ganze noch einmal genauer angesehen. Meine Einlassung mit 1.5 ist natürlich unsinnig gewesen.
Und wie Helmut schreibt macht 2 als dritten Parameter mehr Sinn als die 5.

Und was spricht dagegen statt der Mid Funktion einfach mit dem genauen Ergebnis aus der Rechnung CDate(Pr2) / HStd oder wie Helmut vorschlägt CDate(Pr2) * 48 weiter zu machen.
Es wird ja damit nicht mehr weiter gerechnet, es findet danach nur ein Größenvergleich statt.

[Mario]

Hallo Helmut, hallo Atilla,



danke für die geilen Hinweise. Das Makro läuft jetzt durch. Ich habe statt der Mid Funktion wie von Helmut CDate(Pr2) * 48 benutzt.



Jetzt nur noch einige Anpassungen und es läuft alles wie gewünscht. 

Nochmals vielen Dank für die schnelle Hilfe von Euch.  :28:



Viele Grüße 



Mario