Hallo Michael,
Trotz Häckchen wollte meine letzte Beitrag nicht in die Offenheit. Hier aber den Link mit der Fragestellung und meine hochgeladene Datei:
https://www.herber.de/forum/archiv/1472to1476/t1472457.htm
Beste Grüße
Erik
Function vonbisH(a1#, a2#, b1#, b2#) As Variant
' Formel aus
' http:// _
www.herber.de/forum/archiv/636to640/639927_Zeitueberschneidungen.html
vonbisH = WorksheetFunction.Max(0, WorksheetFunction.Min(b1, b2) - _
WorksheetFunction.Min(WorksheetFunction.Max(a1, a2), b1))
End Function
Function rechH(s As Variant, istSa As Variant) As Variant
Dim zarr#(1 To 10), znr&, z$, b$, w#, w2#
Dim p&
Const SaVon = 13, SaBis = 21
If InStr(istSa.Text, "Sa") > 0 And Len(s) > 3 Then
s = Replace(s, " ", "+")
s = Replace(s, ",", ".") & "!"
znr = 0
For p = 1 To Len(s)
b = Mid(s, p, 1)
If (b >= "0" And b 0 Then
znr = znr + 1
zarr(znr) = Val(z)
z = ""
End If
End If
Next
If (znr And 1) = 1 Then rechH = "#UNG": Exit Function
' falls Anzahl der Zeiten ungerade, Fehlermeldung "#UNG" und Ende
w2 = 0
For p = 1 To znr - 1 Step 2
w2 = w2 + vonbisH(zarr(p), SaVon, zarr(p + 1), SaBis)
Next
rechH = w2
Else
rechH = ""
End If
End Function
SaVon und SaBis wurden als Konstanten "zentral" definiert, das erleichtert etwaige Änderungen.
Function rechF(s As Variant, istF As Variant) As Variant
rechF = ""
If InStr(istF.Text, "F") > 0 Then rechF = rechD(s, "")
End Function
Damit habe ich aber in Spalte F und G die gleiche Ergebnisse stehen! Will natürlich, dass nur in Spalte F, und nicht in der Spalte G geschrieben wird, wenn es um ein Feiertag handelt, der auf einem Sonntag fällt. Wie könnte das bewerkstelligt werden?
Function rechG(s As Variant, istSo As Variant, istF as variant) As Variant
rechG = ""
If InStr(istSo.Text, "So") > 0 And istF "F" Then rechG = rechD(s, "")
' warum nicht vorhandene Funktionen mehrmals benutzen?
End Function
und natürlich im Tabellenblatt den weiteren Parameter für die Spalte mit den Feiertagen eingeben.
' die nächste Zeile...
rechH = w2
Else
rechH = ""
End If
End Function
' durch die hier:
If Round(w2 * 100, 0) = 0 Then rechH = "" Else rechH = w2
Else
rechH = ""
End If
End Function