Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Differenz durch Mittelwert in VBA

Differenz durch Mittelwert in VBA
Michael
Hallo,
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:
Userbild
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
Danke für die Hilfe.
Viele Grüße
Michael

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Differenz durch Mittelwert in VBA
02.07.2012 11:16:03
Michael
Hallo nochmals,
ich glaube ich habe das Problem teilweise gelöst. Also ich bekomme nun eine Zahl raus die ähnlich ist mit der die ich per Hand gerechnet habe. Leider sieht man das es da doch kleine Unterschiede gibt und ich weiss nicht woher diese herkommen. Mein File kann hier gefunden werden:
https://www.herber.de/bbs/user/80826.xlsm
Danke für die Hilfe.
VG
Michael
Äpfel und Birnen
02.07.2012 11:32:45
Rudi
Hallo,
'von Hand' rechnest du mit Mittelwert alle. Im Code mit dem Mittelwert des Jahres.
Gruß
Rudi
Das sind aber Bananen und Trauben ;-) _oT
02.07.2012 17:06:12
NoNet
_oT = "ohne Text"
Userbild
Anzeige
so genau ...
02.07.2012 22:10:24
Rudi
Hallo,
... kenn ich mich Obst und Gemüse nicht aus. Das ist dein Metier.
Vielleicht Steak und Gulasch? ;-)
Gruß
Rudi
AW: Differenz durch Mittelwert in VBA
02.07.2012 11:18:54
Rudi
Hallo,
wann werden denn objX und objY erzeugt?
Die Arrays kannst du einfacher erzeugen:
    With Sheets(strSheet)
arrX = .Range(.Cells(8, 1), .Cells(Rows.Count, 1).End(xlUp))
arrY = .Range(.Cells(8, 1), .Cells(Rows.Count, 1).End(xlUp)).Offset(, 4)
End With

Geh den Code mal mit F8 durch.
Gruß
Rudi
AW: Differenz durch Mittelwert in VBA
02.07.2012 11:32:47
fcs
Hallo Michael,
ich dachte, dass dies Thema jetzt abgehakt wäre.
Die Lösung hatte ich dir doch schon, bis auf minimale Anpassungsnotwendigkeiten, als Datei hier hochgeladen.
Dabei hatte ich auch geschrieben, dass ich mit dem ListObjekt gewisse Schwierigkeiten hatte und deshalb auf Datenarrays umgestellt hatte um die Daten eines Jahres zu erfassen.. Jetzt taucht das Listobjekt wieder auf ?
Deine Function liefert jetzt einen Fehler, weil du bei Zeilen mit "Call prcDatenObjekt_erzeugen" zu Kommentaren umgewandelt hast. Damit gibt es für Average-Funktion und die For-Next-Schleife keine Daten.
Außerdem kannst du in deiner Formel den Durchschnittswert der Jahreswerte aus dem Summenterm herausnehmen und direkt als Multiplikation in den Nenner übernehmen.
Gruß
Franz
Nach meiner Meinung muss dein Code so aussehen, damit er das korrekte Ergebnis liefert:
Option Explicit
Private objX() As Variant, objY() As Variant, lngCount As Long
Function Delta_Y_Mittelwert_normiert(ByVal intYear As Integer, ByVal strSheet As String)
'Bei intJahr=0 werden alle Daten berücksichtigt
Dim dblSumme As Double
Dim varElement As Variant
Dim dblAverageAll As Double
Dim dblAverageJahr As Double
Dim wsFnc As WorksheetFunction
Set wsFnc = Application.WorksheetFunction
Call prcDatenObjekt_erzeugen(intYear:=intYear, strSheet:=strSheet)
dblAverageJahr = wsFnc.Average(objY)
For varElement = 1 To lngCount - 1
dblSumme = dblSumme + (objY(varElement + 1) - objY(varElement)) / dblAverageJahr
Next
Delta_Y_Mittelwert_normiert = dblSumme / (lngCount - 1)
Erase objX, objY
End Function
Sub prcDatenObjekt_erzeugen(ByVal intYear As Integer, ByVal strSheet As String)
Dim arrX, arrY, lngX As Long
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
lngCount = 0
For lngX = LBound(arrX) To UBound(arrX)
If Year(arrX(lngX, 1)) = intYear Or intYear = 0 Then
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
End If
Next lngX
End Sub

Anzeige
AW: Differenz durch Mittelwert in VBA
02.07.2012 11:47:43
Michael
Hallo Rudi und Franz,
Danke für die Antworten :).
@Rudi: Oops mein Fehler und danke für den Hinweis nun ist alles Identisch :).
@Franz: Hatte das dann auch gelöst siehe Antwort zu meine Frage :).
Danke euch beiden nochmal.
Viele Grüße
Michael

317 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige