Ich brauche zu folgendem Problem Hilfe. Wie im Excel dargestellt:
https://www.herber.de/bbs/user/81584.xlsm
habe ich eine Messung die über zwei Tage und verschiedenen Uhrzeiten geht (In der realität sin es mehr Messdaten). Was nun das Ziel ist eine Berechnung der wie unten angezeigten Std. Abweichung für verschiedene Tage und Zeitpunkte zu Berechnen. Dabei sollen pro Tag die Std. Abw. in verschiedenen Zeitintervallen berechnet werden, z.B.: Std. Abw. 8:00-9:00, 9:00-10:00, 10:00-11:00, ... Das soll auch für verschiedene Tage gemacht werden. Am Ende wird der Mittelwert über alle Messungen durchgeführt. Ein Beispiel ist im angehängten Excel gezeigt. Dabei zeigt die unten angehängte Version einen ersten Schritt der nun mit den Zeitpunkten erweitert werden soll.
Danke für die Hilfe.
Viele Grüße,
Michael
Option Explicit
Private objX() As Variant, objY() 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 wsFnc As WorksheetFunction Call prcDatenObjekt_erzeugen(strSheet:=strSheet) GetLastValue = objY(UBound(objY)) For varElement = 1 To lngCount - 1 dblAverage = dblAverage + (objY(varElement + 1) - objY(varElement)) / objY(varElement) Next dblAverage = dblAverage / (lngCount - 1) For varElement = 1 To lngCount - 1 dblSumStdDev = dblSumStdDev + ((objY(varElement + 1) - objY(varElement)) / objY( _ varElement) - dblAverage) ^ 2 Next dblSumStdDev = (dblSumStdDev / (lngCount - 2)) ^ 0.5 dblSumStdDev = (GetLastValue / 100) * (dblSumStdDev * 100) StdDev = dblSumStdDev Erase objX, objY End Function
Sub prcDatenObjekt_erzeugen(ByVal strSheet As String)
Dim arrX, arrY, lngX As Long
With Sheets(strSheet)
arrX = .Cells(5, 1).Resize(Application.WorksheetFunction.Count(.Range(.Cells(5, 1), _
.Cells(Rows.Count, 1).End(xlUp))))
arrY = .Cells(5, 1).Resize(Application.Count(.Range(.Cells(5, 1), _
.Cells(Rows.Count, 1).End(xlUp)))).Offset(, 1)
End With
lngCount = 0
For lngX = LBound(arrX) To UBound(arrX)
lngCount = lngCount + 1
ReDim Preserve objX(0 To lngCount)
ReDim Preserve objY(0 To lngCount)
objX(lngCount) = arrX(lngX, 1) * 1
objY(lngCount) = arrY(lngX, 1) * 1
Next lngX
End Sub