Formel als Makro

Hallo Leute,
kann man die folgende Formel irgendwie als Makro erstellen ?
WENN(ODER(C7=0;D7=0);0;REST(D7-C7;1)-(REST(D7-C7;1)*24>=6,01)*0,5/24-(REST(D7-C7;1)*24>=9)*0,5/24) +WENN(ODER(E7=0;F7=0);0;REST(F7-E7;1)-(REST(F7-E7;1)*24>=6,01)*0,5/24-(REST(F7-E7;1)*24>=9)*0,5/24) +WENN(ODER(G7=0;H7=0);0;REST(H7-G7;1)-(REST(H7-G7;1)*24>=6,01)*0,5/24-(REST(H7-G7;1)*24>=9)*0,5/24) +WENN(ODER(I7=0;J7=0);0;REST(J7-I7;1)-(REST(J7-I7;1)*24>=6,01)*0,5/24-(REST(J7-I7;1)*24>=9)*0,5/24) +WENN(ODER(K7=0;L7=0);0;REST(L7-K7;1)-(REST(L7-K7;1)*24>=6,01)*0,5/24-(REST(L7-K7;1)*24>=9)*0,5/24) +WENN(ODER(M7=0;N7=0);0;REST(N7-M7;1)-(REST(N7-M7;1)*24>=6,01)*0,5/24-(REST(N7-M7;1)*24>=9)*0,5/24) +WENN(ODER(O7=0;P7=0);0;REST(P7-O7;1)-(REST(P7-O7;1)*24>=6,01)*0,5/24-(REST(P7-O7;1)*24>=9)*0,5/24) +SUMMENPRODUKT((C7:P7={"u";"ft";"k"})*1) *H6/24~f~
~f~ZÄHLENWENN(C7:P7;"U")+ZÄHLENWENN(C11:P11;"U")+ZÄHLENWENN(C15:P15;"U")+ZÄHLENWENN(C19:P19;"U") +ZÄHLENWENN(C23:P23;"U")+ZÄHLENWENN(C27:P27;"U")
So das es sich um die dazu kommenden Zeilen erweitert bzw. auch diese ausrechnet ?
https://www.herber.de/bbs/user/108801.xlsx
Vielen dank schon mal für eure Mühe.
VG
Sven

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Sub rechnen() Dim ListStr Dim PauseUeber6 As Date, PauseUeber8 As Date, Date1 As Date, Date2 As Date Dim Jein As Long, Firstcell As Long, x As Long, c As Long Dim WStunden As Double, MStunden As Double Dim NamenDazu As String Dim Ws As Worksheet PauseUeber6 = "00:30:00" PauseUeber8 = "00:45:00" NamenDazu = ",Name1,Name2,Name3" ' Hier die Namen der Worksheets eintragen die auch berechnet _ werden sollen aber nicht Januar-Dezember heißen" For Each Ws In ThisWorkbook.Worksheets Jein = InStr(1, Join(Application.GetCustomListContents(8), ",") & NamenDazu, Ws.Name) If Not Jein = 0 Then With Ws Firstcell = 7 Do While Not IsEmpty(.Cells(Firstcell + x, 1)) For c = 3 To 16 Step 2 If IsNumeric(.Cells(Firstcell + x, c).Value) Then Date1 = CDate(.Cells(Firstcell + x, c).Value) Date2 = CDate(.Cells(Firstcell + x, c).Offset(0, 1).Value) If (Date2 - Date1) > CDate("08:00:00") Then WStunden = WStunden + (Date2 - Date1 - (1 * CDate(PauseUeber8))) ElseIf (Date2 - Date1) > CDate("06:00:00") Then WStunden = WStunden + (Date2 - Date1 - (1 * CDate(PauseUeber6))) Else WStunden = WStunden + (Date2 - Date1) End If End If Next With .Range("T" & Firstcell + x) .Value = WStunden .NumberFormat = "[h]:mm:ss;@" End With MStunden = MStunden + WStunden WStunden = 0 x = x + 4 Loop With .Range("U" & Firstcell) .Value = MStunden .NumberFormat = "[h]:mm:ss;@" End With End With MStunden = 0 x = 0 End If Next End Sub

Ja das müsste auch gehen solange dein format so bleibt ´wie in der Bsp. Datei.
Hier ersetz mal war noch ein kleiner Fehler drinne

Option Explicit
Sub rechnen()
Dim ListStr
Dim PauseUeber6 As Date, PauseUeber8 As Date, Date1 As Date, Date2 As Date
Dim Jein As Long, Firstcell As Long, x As Long, c As Long
Dim WStunden As Double, MStunden As Double
Dim NamenDazu As String
Dim Ws As Worksheet
On Error GoTo err
On Error Resume Next
Dim NAmeSort As Worksheet
Dim FindenName As Range, FindenSonder As Range
Set NAmeSort = ThisWorkbook.Worksheets("NamenSonderWerte")
PauseUeber6 = "00:30:00"
PauseUeber8 = "00:45:00"
NamenDazu = "Name1,Name2,Name3" ' Hier die Namen der Worksheets eintragen die auch berechnet  _
werden sollen aber nicht Januar-Dezember heißen"
For Each Ws In ThisWorkbook.Worksheets
Jein = 0
Jein = Application.WorksheetFunction.Match(CStr(Ws.Name), Split(Join(Application. _
GetCustomListContents(8), ",") & "," & NamenDazu, ","), 0)
'Jein = InStr(1, Join(Application.GetCustomListContents(8), ",") & NamenDazu, Ws.Name)
If Not Jein = 0 Then
With Ws
Firstcell = 7
Do While Not IsEmpty(.Cells(Firstcell + x, 1))
For c = 3 To 16 Step 2
If IsNumeric(.Cells(Firstcell + x, c).Value) Then
Date1 = CDate(.Cells(Firstcell + x, c).Value)
Date2 = CDate(.Cells(Firstcell + x, c).Offset(0, 1).Value)
If (Date2 - Date1) > CDate("08:00:00") Then
WStunden = WStunden + (Date2 - Date1 - (1 * CDate(PauseUeber8)))
ElseIf (Date2 - Date1) > CDate("06:00:00") Then
WStunden = WStunden + (Date2 - Date1 - (1 * CDate(PauseUeber6)))
Else
WStunden = WStunden + (Date2 - Date1)
End If
Else
Set FindenName = NAmeSort.Columns(1).Find(.Cells(Firstcell + x, 1).Value,  _
LookIn:=xlValues)
Set FindenSonder = NAmeSort.Rows("1:1").Find(.Cells(Firstcell + x, c).Value,  _
LookIn:=xlValues)
Select Case UCase(.Cells(Firstcell + x, c).Value)
Case "K"
WStunden = WStunden + CDate(NAmeSort.Cells(FindenName.Row, FindenSonder.Column). _
Value)
Case "FT"
WStunden = WStunden + CDate(NAmeSort.Cells(FindenName.Row, FindenSonder.Column) _
.Value)
Case "K"
WStunden = WStunden + CDate(NAmeSort.Cells(FindenName.Row, FindenSonder.Column) _
.Value)
End Select
End If
Next
With .Range("R" & Firstcell + x)
.Value = WStunden
.NumberFormat = "[h]:mm:ss;@"
End With
MStunden = MStunden + WStunden
WStunden = 0
x = x + 4
Loop
With .Range("S" & Firstcell)
.Value = MStunden
.NumberFormat = "[h]:mm:ss;@"
End With
End With
MStunden = 0
x = 0
End If
Next
Exit Sub
err:
MsgBox "In der  Tabelle " & NAmeSort.Name & " kann der Name einer Person nicht gefunden  _
werden "
End Sub

Gruß Basti

Function Zeitberechnung(Beginn_EndZeiten As Range, Zeit_Bei_FT_K_U As Double) As Double Dim arrZeit Dim s As Long Dim T As Double arrZeit = Beginn_EndZeiten.Value For s = 1 To UBound(arrZeit, 2) Step 2 If IsNumeric(arrZeit(1, s)) And IsNumeric(arrZeit(1, s + 1)) Then If (arrZeit(1, s + 1) * arrZeit(1, s)) > 0 Then T = arrZeit(1, s + 1) - arrZeit(1, s) If T > TimeSerial(6, 0, 0) Then T = T - TimeSerial(0, 30, 0) If T > TimeSerial(8, 0, 0) Then T = T - TimeSerial(0, 30, 0) Zeitberechnung = Zeitberechnung + T End if Else Select Case LCase(arrZeit(1, s)) Case "u", "k", "ft" Zeitberechnung = Zeitberechnung + Zeit_Bei_FT_K_U End Select End If Next End Function

=SUMMENPRODUKT(WENN(ISTZAHL(C7:O7);WENN(ISTUNGERADE(SPALTE(C7:O7));(D7:P7-C7:O7)-WENN((D7:P7-C7:O7) >ZEIT(8;0;0);ZEIT(0;30;0))-WENN((D7-P7-C7:O7)>ZEIT(8;0;0);ZEIT(0;30;0)));WENN(C7:O7""; ISTZAHL(SUCHEN(C7:O7;"_K_U_FT_"))*ZEIT(6;40;0))))

Beliebteste Forumthreads (12 Monate)

23 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

23
Beiträge zum Forumthread

Beiträge zu diesem Forumthread