Differenz durch Mittelwert in VBA
Michael
ich hatte bereits eine Diskussion hier im Forum bzgl. dieses Themas und hatte am Ende versucht das Problem selber zu lösen aber bin leider gescheitert. Ich kann meine Alte Diskussion auch nicht mehr aufrufen bzw. weiss ich nicht ob die offene Frage noch gesehen werden kann. Ich möchte folgende Formel in VBA umsetzen:
Der Code sieh wie folgt aus, aber leider kommt als Fehler nur #wert raus:
Option Explicit
Dim objX As Object, objY As Object
Function Abweichung2(ByVal intYear As Integer, ByVal strSheet As String)
Dim dblSumSqrY As Double
Dim varElement As Variant
Dim dblAverageAll As Double
Dim wsFnc As WorksheetFunction
Set wsFnc = Application.WorksheetFunction
'Call prcDatenObjekt_erzeugen(intYear:=0, strSheet:=strSheet)
dblAverageAll = wsFnc.Average(objY.items)
'Call prcDatenObjekt_erzeugen(intYear:=intYear, strSheet:=strSheet)
'Mittelwert der relativen Änderung
For varElement = 1 To objY.Count - 1
dblSumSqrY = dblSumSqrY + (objY(varElement + 1) - objY(varElement)) / dblAverageAll
Next
Abweichung = dblSumSqrY / (objY.Count - 1)
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 Or intYear = 0 Then
objX(lngX) = arrX(lngX, 1) * 1
objY(lngX) = arrY(lngX, 1) * 1
End If
Next lngX
End Sub
Viele Grüße
Michael
