Wenn Pause kleiner 30 Sek dann Summe

[Reismann]

Vielen Dank Atilla!

Ich habe mir deinen Code mal genauer angesehen und ein wenig "Reverse Engineering" betrieben, und anschießend noch ein wenig erweitert mit neuen Ideen.

Ich rechne die Pause jetzt noch mit in das Ergebnis und formatiere mir das Ergebnis rot wenn die Zeit größer 10 Minuten ist. Ich denke so lasse ich es jetzt erst mal. Beim Schwellwert von 30 Sekunden bin ich noch am probieren ob ich den noch weiter ändere. Aber das funktioniert ja ganz einfach im Code dank deiner super Arbeit.

Jetzt habe ich auf jeden Fall was gelernt.  

Code:

Option Explicit

Sub Teilsummen()
 Dim i As Long, j As Long, t As Long
 Dim lngZ As Long
 lngZ = Cells(Rows.Count, 2).End(xlUp).Row

 For t = 6 To 54 Step 8
   lngZ = Cells(Rows.Count, 2).End(xlUp).Row
   Range(Cells(2, t + 1), Cells(lngZ, t + 1)).ClearContents
   Range(Cells(2, t - 1), Cells(lngZ, t + 1)).Interior.ColorIndex = xlNone
   i = 4
   j = 0
   Do
     If Cells(i, t) < 1 / 86400 * 20 Then
       j = i
       Do While (Cells(i + 1, t) < 1 / 86400 * 20) And (Cells(i + 1, t - 1) <> "")
         i = i + 1
       Loop
       Cells(i, t + 1) = Application.Sum(Range(Cells(j - 1, t - 1), Cells(i, t - 1)), Range(Cells(j, t), Cells(i, t)))
       Range(Cells(j - 1, t - 1), Cells(i, t - 1)).Interior.ColorIndex = 50
       Range(Cells(j, t), Cells(i, t)).Interior.ColorIndex = 6
       j = 0
       If Cells(i, t + 1) > 1 / 86400 * 600 Then
         Cells(i, t + 1).Interior.ColorIndex = 3
       Else
         End If
     End If
     i = i + 1
   Loop While Cells(i, t) <> ""
 Next t
End Sub

[Rabe]

Hi,

Ich habe mir deinen Code mal genauer angesehen und ein wenig "Reverse Engineering" betrieben, und anschießend noch ein wenig erweitert mit neuen Ideen.

das gefällt mir, so stelle ich mir den idealen Frager vor: versucht die Antwort zu verstehen, nachzuvollziehen und dann gleich erweitern
:100: :18: