Ich habe hier mal was gezaubert. Das problem hier ist nur, dass die Mittwertwert berechnung nicht wie im Bild für immer nur eine Reihe gerechnet wird, sondern alle reihe für reihe akkumuliert wird. Es nimmt zwar nur die Roten Zahlen zur Berechnung, aber pakt die nächste reihe auch dazu, was nicht sien sollte. Hat da jemand ein tip?
http://www.imagenetz.de/?change=upload&file=9db9eab4c3724b95c1d70f216
Sub Schaltfläche1_Klicken()
Dim wb As Workbook, wq As Object
Dim ws As Worksheet, datDatum
Dim cell As Range
Dim c As Long, r As Long, rng As Range
With Worksheets("Tabelle1")
For c = 3 To 5
For r = 1 To 5
If .Cells(r, c).DisplayFormat.Interior.Color = vbRed Then
If rng Is Nothing Then
Set rng = .Cells(r, c)
Else
Set rng = Union(rng, .Cells(r, c))
End If
End If
Next r
.Cells(8, c).Formula = "=average(" & rng.Address(1, 1) & ")"
Next c
End With
End Sub
|