Berechnung std. Abweichung pro Std.
Michael
ich hatte schon einen ähnlichen Beitrag in diesem Forum, muss die Frage aber neu Stellen, da es nicht die gewünschte Lösung gab (Danke an die vorherigen Vorschläge vorab). Anbei ist das Excel wie die Lösung aussehen sollte:
https://www.herber.de/bbs/user/81824.xlsm
Im Excel wird gezeigt wie die Lösung berechnet wird. Ich möchte am Ende im VBA Code nur den Mittelwert der in Spalte I1 gezeigt wird erhalten. Spalte D und H sind nur Nebenrechnungen. Dabei soll erstmal die relative Änderung berechnet werden im Makro (Spalte I) und dann die Standard Abweichung pro Std. und Tag (Spalte H). Am Ende wird der Mittelwert über die Std. Abweichungen gebildet (Spalte I). Unten ist mein VBA Code. Dort habe ich im Prinzip bereits Spalte I und H berechnet leider über alle Std. und Tage aber nicht so wie ich es im Beispiel Excel habe:
Option Explicit
Private objA() As Variant, objB() As Variant, objC() As Variant, lngCount As Long
Function StdDev(strSheet As String) As Double
Dim dblAverage As Double
Dim dblSumStdDev As Double
Dim GetLastValue As Double
Dim varElement As Variant
Dim stunde As Long
Dim wsFnc As WorksheetFunction
Call prcDatenObjekt_erzeugen(strSheet:=strSheet)
GetLastValue = objC(UBound(objC))
For varElement = 1 To lngCount - 1
dblAverage = dblAverage + (objC(varElement + 1) - objC(varElement)) / objC(varElement)
Next
dblAverage = dblAverage / (lngCount - 1)
For varElement = 1 To lngCount - 1
dblSumStdDev = dblSumStdDev + ((objC(varElement + 1) - objC(varElement)) / objC( _
varElement) - dblAverage) ^ 2
Next varElement
dblSumStdDev = (dblSumStdDev / (lngCount - 2)) ^ 0.5
StdDev = dblSumStdDev
Erase objA, objB, objC, objD
End Function
Sub prcDatenObjekt_erzeugen(ByVal strSheet As String)
Dim arrA, arrB, arrC, arrD, lngX As Long
With Sheets(strSheet)
arrA = .Cells(2, 1).Resize(Application.WorksheetFunction.Count(.Range(.Cells(2, 1), _
.Cells(Rows.Count, 1).End(xlUp))))
arrB = .Cells(2, 1).Resize(Application.WorksheetFunction.Count(.Range(.Cells(2, 1), _
.Cells(Rows.Count, 1).End(xlUp)))).Offset(, 1)
arrC = .Cells(2, 1).Resize(Application.WorksheetFunction.Count(.Range(.Cells(2, 1), _
.Cells(Rows.Count, 1).End(xlUp)))).Offset(, 2)
End With
lngCount = 0
For lngX = LBound(arrA) To UBound(arrA)
lngCount = lngCount + 1
ReDim Preserve objA(0 To lngCount)
ReDim Preserve objB(0 To lngCount)
ReDim Preserve objC(0 To lngCount)
objA(lngCount) = arrA(lngX, 1) * 1
objB(lngCount) = arrB(lngX, 1) * 1
objC(lngCount) = arrC(lngX, 1) * 1
Next lngX
End Sub
VG,
Michael