Differenz durch Mittelwert in VBA
Michael
ich habe verschiedene Messungen in verschiedenen Jahren (siehe Datei unten):
https://www.herber.de/bbs/user/80679.xlsm
Dabei möchte ich folgendes in VBA berechnen:
=(E10-E9)/Mittelwert(E8:E33)
=(E11-E10)/Mittelwert(E8:E33)
...
für das Jahr 1996, dann 1997 usw. Ich habe mal ein händisches Beispiel für das Jahr 1996 in Spalte i gerechnet und das dann Summiert. Das Ergebnis ist in Spalte L9 gezeigt. Wenn ich das nun mittels meiner Funktion ausrechne kommt ein anderes Ergebnis raus.
Ich glaube hier liegt das Problem:
dblAverageAll = wsFnc.Average(Range("E:E"))
Ist es möglich das anders zu definieren.
Das Makro ist dabei:
Option Explicit
Dim objX As Object, objY As Object
Function Abweichung(ByVal intYear As Integer, ByVal strSheet As String)
Dim dblSumSqrY As Double
Dim varElement As Variant
Dim dblAverageAll As Double
Dim wsFnc As WorksheetFunction
Call prcDatenObjekt_erzeugen(intYear:=intYear, strSheet:=strSheet)
Set wsFnc = Application.WorksheetFunction
dblAverageAll = wsFnc.Average(Range("E:E"))
For Each varElement In objY.items
dblSumSqrY = dblSumSqrY + (((varElement + 1) - varElement) / dblAverageAll)
Next
Abweichung = dblSumSqrY
Set objX = Nothing
Set objY = Nothing
End Function
Sub prcDatenObjekt_erzeugen(ByVal intYear As Integer, ByVal strSheet As String)
Dim arrX, arrY, lngX As Long
Set objX = Nothing
Set objY = Nothing
With Sheets(strSheet)
arrX = .Cells(8, 1).Resize(Application.WorksheetFunction.Count(.Range(.Cells(8, 1), _
.Cells(Rows.Count, 1).End(xlUp))))
arrY = .Cells(8, 1).Resize(Application.Count(.Range(.Cells(8, 1), _
.Cells(Rows.Count, 1).End(xlUp)))).Offset(, 4)
End With
Set objX = CreateObject("Scripting.Dictionary")
Set objY = CreateObject("Scripting.Dictionary")
For lngX = LBound(arrX) To UBound(arrX)
If Year(arrX(lngX, 1)) = intYear Then
objX(lngX) = arrX(lngX, 1) * 1
objY(lngX) = arrY(lngX, 1) * 1
End If
Next lngX
End Sub
Viele Grüße
Michael
