Formel als Makro

Sven · 2016-10-15T09:21:12+00:00

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

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

Hi
ich würde hier nicht unbedingt mit einem Makro arbeiten, sondern eine benutzerdefinierte Funktion erstellen, welche genau für dein Problem geeignet ist.
Dann schriebst du einfach nur diese Funktion in die entsprechenden Zellen.
dh ins Modul kommt dieser Code:

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

und in die Zelle R7 dann diese Formel:

=Zeitberechnung(C7:P7;ZEIT(6;40;0))

der erste Parameter sind die Zellen mit den Komm- und Geh-Zeiten (immer abwechselnd)
der zweite Parameter ist die Zeit, die bei K; U und FT eingesetzt wird.
Welche Abzüge für die Pausen gemacht werden, kannst du im Code leicht erkennen und ggf anpassen.
hier ist es eine halbe Stunde bei mehr als 6h Arbeitszeit und eine Stunde bei mehr als 8h Arbeitszeit (wie in deiner Formel). Die berechnug erfolgt additiv.
Alternativ kannst du die Formel aber auch kürzen und die Berechnung mit dieser Formel machen:
Ist ne Matrixformel, dh eingabe immer mit SHIFT+STRG+ENTER abschließen.

=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))))

Gruß Daniel

Forumthread: Formel als Makro

23
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Formel als Makro

Forumthread: Formel als Makro

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

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

23
Beiträge zum Forumthread

Beiträge zu diesem Forumthread