23.02.2022, 19:35
Ich möchte die Woche jeweils Addieren und am Monatsende die Gesamtstunden dann haben.
mein derzeitiger Stand ist
Sub Berechnen()
Dim z
Dim Woche As Double
Woche = 0
arr = Sheets("Legende").Range("C7:N59")
For z = 18 To 59
i = indx(Cells(z, 1))
If i > 0 Then
If i < 1 Then Exit For
Cells(z, 4) = arr(i, 5)
Cells(z, 5) = arr(i, 6)
Cells(z, 6) = arr(i, 6) - arr(i, 5): If Cells(z, 6) < 0 Then Cells(z, 6) = Cells(z, 6) + 1
Cells(z, 7) = arr(i, 7)
Cells(z, 8) = arr(i, 8)
Cells(z, 9) = arr(i, 8) - arr(i, 7)
Cells(z, 10) = Cells(z, 9)
Cells(z, 12) = arr(i, 9)
Cells(z, 13) = arr(i, 10)
Cells(z, 14) = arr(i, 10) - arr(i, 9): If Cells(z, 14) < 0 Then Cells(z, 14) = Cells(z, 14) + 1
Cells(z, 17) = arr(i, 1)
Cells(z, 19) = arr(i, 3)
Cells(z, 20) = arr(i, 4)
Cells(z, 21) = arr(i, 4) - arr(i, 3): If Cells(z, 21) < 0 Then Cells(z, 21) = Cells(z, 21) + 1
Cells(z, 23) = arr(i, 7)
End If
Next z
End Sub
Eine Beispieldatei kann ich bei euch bestimmt auch Hochladen
Ich werde es finden
Eine Nachberechnung habe ich DANK des Internet's auch schon
jedoch wollte ich das in der Sub Berechnung integrieren
Hier meine Nachberechnung
Sub Schicht_nachberechnen()
Dim R As Long 'R wie Row
Dim SumWoche
Dim SumMonat
With ActiveSheet
For R = 18 To 59
Select Case .Cells(R, "C")
Case "Mo", "Di", "Mi", "Do", "Fr", "Sa", "So"
.Cells(R, "F") = .Cells(R, "E") - .Cells(R, "D") + IIf(.Cells(R, "E") < .Cells(R, "D"), 1, 0)
SumWoche = SumWoche + .Cells(R, "F")
SumMonat = SumMonat + .Cells(R, "F")
Case Else
.Cells(R, "F") = SumWoche
SumWoche = 0
End Select
Next
.Cells(60, "F") = SumMonat
End With
End Sub
Mein Lösungsansatz war der
Sub Addition()
Dim Spalte As Integer
Dim x As Integer
Spalte = 6
For M = 1 To 20
Cells(10, Spalte).Value = Summe(Spalte)
Spalte = Spalte + 1
Next M
End Sub
Function Summe(Spalte As Integer)
Spalte1 = Spalte
Zeile1 = 3
With ActiveSheet
For N = 1 To 7
Summe = .Cells(Zeile1, Spalte1).Value + Summe
Zeile1 = Zeile1 + 1
Next N
End With
End Function
mein derzeitiger Stand ist
Sub Berechnen()
Dim z
Dim Woche As Double
Woche = 0
arr = Sheets("Legende").Range("C7:N59")
For z = 18 To 59
i = indx(Cells(z, 1))
If i > 0 Then
If i < 1 Then Exit For
Cells(z, 4) = arr(i, 5)
Cells(z, 5) = arr(i, 6)
Cells(z, 6) = arr(i, 6) - arr(i, 5): If Cells(z, 6) < 0 Then Cells(z, 6) = Cells(z, 6) + 1
Cells(z, 7) = arr(i, 7)
Cells(z, 8) = arr(i, 8)
Cells(z, 9) = arr(i, 8) - arr(i, 7)
Cells(z, 10) = Cells(z, 9)
Cells(z, 12) = arr(i, 9)
Cells(z, 13) = arr(i, 10)
Cells(z, 14) = arr(i, 10) - arr(i, 9): If Cells(z, 14) < 0 Then Cells(z, 14) = Cells(z, 14) + 1
Cells(z, 17) = arr(i, 1)
Cells(z, 19) = arr(i, 3)
Cells(z, 20) = arr(i, 4)
Cells(z, 21) = arr(i, 4) - arr(i, 3): If Cells(z, 21) < 0 Then Cells(z, 21) = Cells(z, 21) + 1
Cells(z, 23) = arr(i, 7)
End If
Next z
End Sub
Eine Beispieldatei kann ich bei euch bestimmt auch Hochladen
Ich werde es finden
Eine Nachberechnung habe ich DANK des Internet's auch schon
jedoch wollte ich das in der Sub Berechnung integrieren
Hier meine Nachberechnung
Sub Schicht_nachberechnen()
Dim R As Long 'R wie Row
Dim SumWoche
Dim SumMonat
With ActiveSheet
For R = 18 To 59
Select Case .Cells(R, "C")
Case "Mo", "Di", "Mi", "Do", "Fr", "Sa", "So"
.Cells(R, "F") = .Cells(R, "E") - .Cells(R, "D") + IIf(.Cells(R, "E") < .Cells(R, "D"), 1, 0)
SumWoche = SumWoche + .Cells(R, "F")
SumMonat = SumMonat + .Cells(R, "F")
Case Else
.Cells(R, "F") = SumWoche
SumWoche = 0
End Select
Next
.Cells(60, "F") = SumMonat
End With
End Sub
Mein Lösungsansatz war der
Sub Addition()
Dim Spalte As Integer
Dim x As Integer
Spalte = 6
For M = 1 To 20
Cells(10, Spalte).Value = Summe(Spalte)
Spalte = Spalte + 1
Next M
End Sub
Function Summe(Spalte As Integer)
Spalte1 = Spalte
Zeile1 = 3
With ActiveSheet
For N = 1 To 7
Summe = .Cells(Zeile1, Spalte1).Value + Summe
Zeile1 = Zeile1 + 1
Next N
End With
End Function