AW: Formel zum übertragen von Zeiten
12.02.2016 02:40:55
Zeiten
hallo
anbei eine Makro Lösung das die Stundenzeiten kopiert
Bitte einmal testen, wenn das Ergebnis nicht okay ist Datei ohne Speichern schliessen.
Ein Nachtei ist zur Zeit das die Set Anweisung: Set DZt = Sheets("Dienstzeiten Januar")
sich hier auf den Monat Januar bezieht und für Februar im Makro geandert werden muss.
Es ginge evtl. auch über den Namen der VBA Komponente, die ist mir aber nicht bekannt.
Ich nehme an das ab 5 Std. 30 Minuten Pause abzuziehen sind: Sonst PAZ=500 aendern
PS: die Beispieldatei lief auf meinem PC extrem langsam, ich nehme an das es sehr viele
Formeln gibt. Bleibt die Frage ob man sie nicht durch Konstante Werte ersetzen könnte?
Würde mich freuen wenn es klappt.
mfg Piet
Option Explicit
'Dienstzeiten: Datum ab D2, G2, J2
'Dienstzeiten: C=Name, B=DG Diestgrad, A=LfNr (Zeilen Ende 83)
'Stundenzettel G4 Name, C6-Beginn, D6-Ende, B=Datum, A=Wo-Tag
Const PAZ = 500 'Pausenabzug ab: 5 Stunden
Const Pause = 30 'Pausenzeit in Minuten
Dim DZt As Object, Stz As Object 'Tabellen Namen
Dim MName, Monat, Tag, DZ, SZ, sp 'Mitarbeiter, Objekte
Dim DZAdr, AZeit, EZeit, Stunden 'DZ-Adr Dienstzeit Adr
Sub Stunden_Daten_übertragen()
Set Stz = Sheets("Stundenzettel")
Set DZt = Sheets("Dienstzeiten Januar")
On Error GoTo Fehler: Err = Empty
'Berechnen abschalten (dauert sonst ewig)
Application.Calculation = xlManual
'Monat + Mitarbeiter laden zum vergleichen
Monat = Month(Stz.Range("G2"))
MName = Stz.Range("G4").Value
'Schleife zum suchen des Mitarbeiter in Dienstzeiten
For Each DZ In DZt.Range("C3", DZt.[c200].End(xlUp))
If MName = DZ.Value Then DZAdr = DZ.Address: Exit For
Next DZ
'Schleife zum auflisten der Tage
For Each SZ In Stz.Range("B6:B46")
If Monat = Month(SZ) Then
'Tag über Offset ab Spalte D2
Tag = Day(SZ) - 1: sp = Tag * 3 + 2
AZeit = DZt.Range(DZAdr).Cells(1, sp)
EZeit = DZt.Range(DZAdr).Cells(2, sp)
SZ.Cells(1, 2) = AZeit 'Anf-Zeit
SZ.Cells(1, 3) = EZeit 'End-Zeit
'Stundenzeiten berechnen über 1200 (12:00)
Stunden = 1200 - AZeit + EZeit - 1200
If Stunden > PAZ Then Stunden = Stunden - Pause
SZ.Cells(1, 4) = Stunden / 100 '900 = 9:00
End If
Next SZ
'** kein -Exit Sub- damit Berechnen aktiviert wird!!
Fehler: Application.Calculation = xlAutomatic
'ggf. Fehlermeldung ; nur bei Err > 0
If Err > 0 Then MsgBox "unerwarteter Fehler"
End Sub