Nachtzuschlag (@Tino)

Guten Morgen zusammen,
die Tage über hab ich Dank Tinos Hilfe eine Prozedur bekommen, die Arbeiten an Samstagen in der Zeit von 13:00 bis 21:00 erkennt
und in eine gesonderte Spalte aufführt. Diese Prozedur funktioniert schlicht perfekt:

Sub Samstag()
Dim ErgebnisBereich As Range
'Funktion BerechneZeiten (steht im Modul ModulFunktion)
'1. Parameter von Zeit (als Uhrzeit)
'2. Parameter bis Zeit (als Uhrzeit)
'3. Parameter Bereich wo Ergebnis hinkommt
'4. Parameter Bereich mit den Wochentagen
'5. bis n ... Parameter Bereich wo die Werte stehen (entsprechend erweiterungsfähig)
With Sheets("TVöD") 'Tabellenname eventuell anpassen
Set ErgebnisBereich = .Range("AD5:AD35") 'Bereich für die Ergebnisse
ErgebnisBereich.Value = "" 'erst mal leer machen
ErgebnisBereich = BerechneZeit(TimeSerial(13, 0, 0), TimeSerial(21, 0, 0), ErgebnisBereich, . _
Range("B5:B35"), .Range("M5:N35"), .Range("Q5:R35"), .Range("U5:V35"))
End With
Range("BL8").Value = WorksheetFunction.Sum([AD5:AD35])
End Sub



Function BerechneZeit(StundeVon As Double, StundeBis As Double, ErgebnisBereich As Variant, _

ArrayWochentag As Variant, ParamArray WerteBereiche() As Variant)

Dim A As Long, B As Long

Dim Werte, ArrayErgebnis

ArrayErgebnis = ErgebnisBereich

With Application.Worksheet

Function 'für min Max Funktion
'Einzelwerte berechnen
For B = LBound(WerteBereiche) To UBound(WerteBereiche)  'Bereiche durchlaufen
Werte = WerteBereiche(B)
For A = 1 To UBound(Werte) 'Schleife über Array
If ArrayWochentag(A, 1) = "Sa" Then
If Werte(A, 2) > StundeVon Then
If Werte(A, 1) 


Vielen von Euch haben es sicher bemerkt, das ich immer wieder frage, weil mir immer wieder die gleichen Dinge bisher ein Geheimnis bleiben. 

Tinos Prozedur konnte ich bisher nur soweit selber anpassen, als das eben der Zuschlag nunmehr von 0:00 bis 6:00 an jedem Wochentag erkannt wird. 

Nunmehr brauche ich aber zwei Varianten, die ich nicht hinbekomme:

Nicht nur eine Zeit eines Zuschlags, sondern zwei Zeiten müssen Berücksichtigung finden. Die erste halt von 0:00 bis 6:00, eine weitere dann von 21:00 bis 24:00. Insoweit wäre der Ergebnisbereich um die Bedingung des zweiten Zuschlags zu erweitern. Wie aber füge ich diese weitere Bedingung dazu, das die Prozedur mir eben Arbeiten in der Zeit von 0:00 bis 6:00 und von 21:00 bis 24:00 zusammenrechnet und in einer gesonderte Spalte aufführt?

Bei der zweiten Variante mache ich vielleicht nur einen Fehler? Ich habe über die nachfolgende Prozedur die Feiertage für das laufende Kalenderjahr ermittelt:
Sub Ostersonntag()
On Error Resume Next
Dim intjahr As Integer
Dim BegDatum, y As Date
Dim x As Integer
Application.ScreenUpdating = False
BegDatum = Worksheets("Start").Range("K10")
Worksheets("Start").Select
Range("K11").Value = Format(Year(BegDatum), "0000")
intjahr = Worksheets("Start").Range("K11")
x = (((255 - 11 * (intjahr Mod 19)) - 21) Mod 30) + 21
y = DateSerial(intjahr, 3, 1) + x + (x > 48) + 6 - ((intjahr + intjahr \ 4 + x + (x > 48) + 1)   _
_
Mod 7)
Worksheets("Feiertage").Range("F11") = DateSerial(intjahr, 1, 1)
Worksheets("Feiertage").Range("F12") = y - 2
Worksheets("Feiertage").Range("F13") = y
Worksheets("Feiertage").Range("F14") = y + 1
Worksheets("Feiertage").Range("F15") = DateSerial(intjahr, 5, 1)
Worksheets("Feiertage").Range("F16") = y + 39
Worksheets("Feiertage").Range("F17") = y + 49
Worksheets("Feiertage").Range("F18") = y + 50
Worksheets("Feiertage").Range("F19") = y + 60
Worksheets("Feiertage").Range("F20") = DateSerial(intjahr, 10, 3)
Worksheets("Feiertage").Range("F21") = DateSerial(intjahr, 11, 1)
Worksheets("Feiertage").Range("F22") = DateSerial(intjahr, 12, 25)
Worksheets("Feiertage").Range("F23") = DateSerial(intjahr, 12, 26)
Worksheets("Feiertage").Range("F25") = y - 48
Worksheets("Feiertage").Range("F26") = DateSerial(intjahr, 12, 24)
Worksheets("Feiertage").Range("F27") = DateSerial(intjahr, 12, 31)
End Sub


Nun möchte ich mit Hilfe Tinos Prozedur z.B. am Karsamstag Arbeiten in der Zeit von 6:00 bis 14:00 in eine andere Spalte aufführen lassen. Hierzu ändere ich die Zeile

If ArrayWochentag(A, 1) = "Sa" Then

in

If ArrayWochentag(A, 1) = y - 1

Funktioniert natürlich nur wenn die Erklährung, was denn nu y ist mit in der Routine steht. Soweit verstehe ich das noch...

Die Prozedur gibt mir, so angepasst, zwar keinen Fehler, funktioniert aber einfach nicht. Was läuft da falsch? 

Brauche wirklich Eure Nachhilfe. Solche Prozeduren, mit denen Berechnungen erfolgen schaffe ich bisher einfach noch nicht nachzuvollziehen. Sorry

Besten Dank

Uwe

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Option Explicit Sub SummeSamstagZuschlag() Dim ErgebnisBereich As Range 'Funktion BerechneZeiten (steht im Modul ModulFunktion) '1. Parameter von Zeit (als Uhrzeit) '2. Parameter bis Zeit (als Uhrzeit) '3. Parameter Bereich wo Ergebnis hinkommt '4. Parameter Bereich mit den Wochentagen '5. bis n ... Parameter Bereich wo die Werte stehen (entsprechend erweiterungsfähig) With Sheets("Tabelle1") 'Tabellenname eventuell anpassen Set ErgebnisBereich = .Range("AE5:AE35") 'Bereich für die Ergebnisse ErgebnisBereich.Value = "" 'erst mal leer machen Call _ BerechneZeiten(TimeSerial(0, 0, 0), _ TimeSerial(6, 0, 0), _ ErgebnisBereich, _ .Range("B5:B35"), _ .Range("N5:O35"), .Range("R5:S35"), .Range("V5:W35")) Call _ BerechneZeiten(TimeSerial(21, 0, 0), _ TimeSerial(23, 59, 59), _ ErgebnisBereich, _ .Range("B5:B35"), _ .Range("N5:O35"), .Range("R5:S35"), .Range("V5:W35")) End With End Sub 'Makro zum löschen der Ergebnisse Sub LeoscheErgebnisse() Range("AE5:AE35").Value = "" End Sub

Option Explicit Sub BerechneZeiten(StundeVon As Double, StundeBis As Double, rngErgebnisBereich As Range, rngWochentag As Range, ParamArray WerteBereiche() As Variant) Dim A As Long, B As Long Dim Werte, ArrayErgebnis, ArrayWoche ArrayErgebnis = rngErgebnisBereich ArrayWoche = rngWochentag With Application.WorksheetFunction 'für min Max Funktion 'Einzelwerte berechnen For B = Lbound(WerteBereiche) To Ubound(WerteBereiche) 'Bereiche durchlaufen Werte = WerteBereiche(B) For A = 1 To Ubound(Werte) 'Schleife über Array If ArrayWoche(A, 1) = "Sa" Then 'Sa? If Werte(A, 2) > StundeVon Then If Werte(A, 1) < StundeBis Then If Werte(A, 1) < Werte(A, 2) Then ArrayErgebnis(A, 1) = _ ArrayErgebnis(A, 1) + .Min(Werte(A, 2), StundeBis) - .Max(Werte(A, 1), StundeVon) End If End If End If End If Next A Next B End With rngErgebnisBereich = ArrayErgebnis End Sub

Hallo,
die Funktion

x = (((255 - 11 * (intjahr Mod 19)) - 21) Mod 30) + 21
y = DateSerial(intjahr, 3, 1) + x + (x > 48) + 6 - ((intjahr + intjahr \ 4 + x + (x > 48) + 1) Mod 7)

gibt Dir in y das Datum vom Ostersontag zurück,
in dem Beispiel was ich für Dich mal aufgebaut hatte ist in ArrayWochentag(A, 1) kein Datum
sondern nur Mo, Di, usw kann also so nicht funktionieren.
Wenn ich Dir dabei helfen soll, solltest Du Dich doch mal überwinden und versuchen
eine Beispieldatei hochzuladen, sonst wird dies auch wieder so eine lange Geschichte.
Also um eine Datei hochzuladen,
verwende kurze Pfadtiefen am besten von C:\
verwende keine ä,ö,ü,ß,Sonderzeichen und Leerzeichen im Pfad oder im Dateinamen.
gehe zu
https://www.herber.de/forum/file_upload.html
wähle Deine Datei und lade diese hoch,
den HTML Code den Du erhältst, kopierst Du unverändert in Deinen Beitrag.
Gruß Tino

Sub Nacht() Dim ErgebnisBereich As Range 'Funktion BerechneZeiten (steht im Modul ModulFunktion) '1. Parameter von Zeit (als Uhrzeit) '2. Parameter bis Zeit (als Uhrzeit) '3. Parameter Bereich wo Ergebnis hinkommt '4. Parameter Bereich mit den Wochentagen '5. bis n ... Parameter Bereich wo die Werte stehen (entsprechend erweiterungsfähig) With Sheets("TVöD") 'Tabellenname eventuell anpassen Set ErgebnisBereich = .Range("AD5:AD35") 'Bereich für die Ergebnisse ErgebnisBereich.Value = "" 'erst mal leer machen Call BerechneZeiten1(TimeSerial(0, 0, 0), TimeSerial(6, 0, 0), ErgebnisBereich, .Range("B5:B35") _ , .Range("M5:N35"), .Range("Q5:R35"), .Range("U5:V35")) Call BerechneZeiten1(TimeSerial(21, 0, 0), TimeSerial(24, 0, 0), ErgebnisBereich, .Range("B5: _ B35"), .Range("M5:N35"), .Range("Q5:R35"), .Range("U5:V35")) End With End Sub

Sub BerechneZeiten1(StundeVon As Double, StundeBis As Double, rngErgebnisBereich As Range, _ rngWochentag As Range, ParamArray WerteBereiche() As Variant) Dim A As Long, B As Long Dim Werte, ArrayErgebnis, ArrayWoche ArrayErgebnis = rngErgebnisBereich ArrayWoche = rngWochentag With Application.Worksheet Function 'für min Max Funktion 'Einzelwerte berechnen For B = LBound(WerteBereiche) To UBound(WerteBereiche) 'Bereiche durchlaufen Werte = WerteBereiche(B) For A = 1 To UBound(Werte) 'Schleife über Array If ArrayWoche(A, 1) = "Sa" Then 'Sa? If Werte(A, 2) > StundeVon Then If Werte(A, 1) Diese funktioniert aber leider nicht. Keine Fehlermeldung, kein Ergebnis. Soweit ich`s erkenne müßte der Fehler eher in der Routine BerechneZeiten1 liegen. Gruß Uwe PS: Danke für Deine Hinweise zu Beiträgen und Beispeldateien. Werd mir Mühe geben. PPS: Die Bezeichnung BerechneZeiten1 hatte ich so benannt, da es sonst mit Samstagszuschlag "Streß" gibt.

Beliebteste Forumthreads (12 Monate)

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread