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 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
Danke für die Hilfe.
Viele Grüße
Michael
AW: Differenz durch Mittelwert in VBA
22.06.2012 02:23:22
fcs
Hallo Michael,
das Problem ist nicht die Mittelwertsberechnung, sondern die For-Next-Schleife.
Da du nur n-1 Differenz-Berechnungen machen willst kann du hier nicht mit For Each arbeiten, sondern muss mit dem Element-Zähler arbeiten.
Mit einer kleinen Anpassung in der Daten-Objekt-Prozedur kann man auch die Werte aller Jahre in die Durchschnittberechnung einbeziehen und muss nicht den ggf. gefährlichen Ausweg über Range("E:E") gehen.
Ich hab die Prozedur so angepasst, dass bei intJahr=0 die Werte für alle Jahre in die beiden Daten-Objekt-Variablen übernommen werden.
Du solltest allerdings noch überlegen, ob du bei deiner Berechnung mit den Absolutwerten der Wertdifferenzen arbeiten muss.
Gruß
Franz
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
Set wsFnc = Application.WorksheetFunction
Call prcDatenObjekt_erzeugen(intYear:=0, strSheet:=strSheet)
dblAverageAll = wsFnc.Average(objY.items)
Call prcDatenObjekt_erzeugen(intYear:=intYear, strSheet:=strSheet)
For varElement = 1 To objY.Count - 1
dblSumSqrY = dblSumSqrY + (objY(varElement + 1) - objY(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 Or intYear = 0 Then
objX(lngX) = arrX(lngX, 1) * 1
objY(lngX) = arrY(lngX, 1) * 1
End If
Next lngX
End Sub

Anzeige
AW: Differenz durch Mittelwert in VBA
22.06.2012 06:31:04
Michael
Hallo Franz,
Super Danke :): Hat Funktioniert.
Du solltest allerdings noch überlegen, ob du bei deiner Berechnung mit den Absolutwerten der Wertdifferenzen arbeiten muss.
Was wäre denn dein Vorschlag dazu?
Viele Grüße
Michael
AW: Differenz durch Mittelwert in VBA
22.06.2012 12:14:06
fcs
Hallo Michael,
du berechnest ja von Messwert zu Messwert die Steigung/relative Änderung der Messwerte einer Teilperiode (=Jahr) bezogen auf den Mittelwert der Messwerte über mehrere Jahre.
Allerdings machst du die Berechnung ohne die X-Werte einzubeziehen. Das ist nach meiner Ansicht nur aussagekräftig (zulässig?), wenn die Zeitabstände von Messwert zu Messwert in allen Jahren identisch sind (Tage, Wochen oder Monate).
Ich bin jetzt nicht so der Statistiker, meine aber, dass der Mittelwert der Steigungswerte sinnvoller ist als die Summe der Steigungen. Hier also die Summe der Steigungen noch durch (Anzahl_Messwerte_im_Jahr - 1) dividieren. Dies währe dann eine Aussage über die generelle Richtung im Jahr (Positiv/Negativ) und über die Stärke des Gesamt-Trends.
Mit dem Mittelwerte der Absolutwerte der Differenzen müßte man arbeiten, wenn man die mittlere Plus/Minus Spannweite der Steigungswerte ermitteln möchte. Dies wäre dann eine Aussage über die Varianz/Streuung der Messwerte.
Umsetzung in den VBA-Funktionen
    '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)
'Mittelwert der absolutwerte der relativen Änderungen
For varElement = 1 To objY.Count - 1
dblSumSqrY = dblSumSqrY + VBA.Abs(objY(varElement + 1) - objY(varElement)) /  _
dblAverageAll
Next
Abweichung = dblSumSqrY / (objY.Count - 1)

Gruß
Franz
Anzeige
AW: Differenz durch Mittelwert in VBA
22.06.2012 13:52:29
Michael
Hallo Franz,
Danke für deine Antwort. Darüber muss ich mal etwas Nachdenken. Denn die Differenz der einzel Messung also t2 - t1 sollte die Änderung mit berücksichtigen (also die Steigung von Punkt zu Punkt) und dann normiert werden durch den Mittelwert des gesamten Zeitverlaufs. Kannst du es mal als Formel hier definieren weil es doch immer in VBA schwer nachvollziehrbar ist :)
Danke.
VG
Michael
AW: Differenz durch Mittelwert in VBA
22.06.2012 22:51:23
fcs
Hallo Michael,
hier der Versuch die Formel grafisch aufzubereiten.
Userbild
Ich bin mir auch nicht sicher, ob die Normierung auf den Mittelwert aller Messwerte der richtige Ansatz ist.
Möglicherweise ist das Verhältnis von (Mittelwert aller Messwerte) zu (Mittelwert der Messwerte des Jahres) der bessere Faktor zur Normierung.
Wie schon geschrieben müssen die Zeitabstände zwischen den Messpunkten immer gleich sein.
Korrekter Weise müsste man für die Steigungen mit (Differenz Y-Werte)/(Differenz X-Werte) arbeiten.
Userbild
Gruß
Franz
Anzeige
AW: Differenz durch Mittelwert in VBA
23.06.2012 10:03:41
Michael
Hallo Franz,
Super Danke für diese Aufbereitung :). Genau der erste Block den du hingeschrieben hast ist der wie ich es eigentlich gemeint hatte. Es fehlt aber in der Funktion er n-1 Term (Schlechte Angewohnheit dies immer zu vergessen). Ist es möglich für alle drei Versionen die korrespondierte Excel VBA Version zu erhalten?
Vielen vielen Dank nochmals.
Viele Grüße
Michael
AW: Differenz durch Mittelwert in VBA
24.06.2012 17:36:43
fcs
Hallo Michael,
ich hab die verschiedenen Varianten nochmals als VBA-Funktionen aufbereitet.
Dabei musste ich auch das Scripting-Objekt durch ein Array ersetzen, da es irgendwie mit der Gesamtzahl der Items im Objekt und den Schleifenzählern nicht 100% passte.
Gruß
Franz

Die Datei https://www.herber.de/bbs/user/80709.xlsm wurde aus Datenschutzgründen gelöscht


Anzeige
AW: Differenz durch Mittelwert in VBA
25.06.2012 00:05:30
Michael
Hallo Franz,
Danke für die Mühe. Nur eine Verständnisfrage:
mittlere Delta_Y_normiert ist die Rechnung die ich ursprünglich haben wollte, also der Mittelwert der Steigung zwischen den Messpunkten n eines Jahres normiert auf dem Mittelwert aller Messungen. Ich kann den Wert irgendwie nicht Nachproduzieren wenn ich es mit der Hand Nachrechne. Wenn ich die Summe bilde der differenz und die differenz jeweil mit dem Mittelwert aller Jahre für 1996 Dividiere und dann durch n-1 dividiere erhalte ich nicht für das Jahr 1996 8.90 raus sondern 0.0037. Übersehe ich da was?
Danke nochmals.
Viele Grüße
Michael
Anzeige
AW: Differenz durch Mittelwert in VBA
25.06.2012 07:54:58
fcs
Hallo Michael,
der 1. Wert eines Jahres (im Beispiel die Zeilen mit Jahr = 0) dürfen in die Summe der Differenzen nicht mit einbezogen werden. Das ist innerhalb eines Jahrs ja der Tag für den es keine Differenz zum Vortag gibt, wenn man ein Jahr isoliert betrachtet.
Gruß
Franz
AW: Differenz durch Mittelwert in VBA
25.06.2012 13:31:48
Michael
Hallo Franz,
sorry ich hänge auf dem Schlauch. Ich glaube ich habe mich nicht richtig ausgedrückt. Ist es möglich für jedes Beispiel jeden Schritt nochmal Manuell zu zeigen (also ohne VBA), damit es klar ist was genau gerechnet wurde, weil ich es wirklich nicht nachvollziehen kann :(. Also am besten an einem beispiel das einfachst was ich ursprünglich wollte.
Danke.
VG
Michael
Anzeige
AW: Differenz durch Mittelwert in VBA
25.06.2012 15:45:19
fcs
Hallo Michael,
die entsprechenden Berechnungen per Formel inklusive der Hilfsspalten H bis L habe ich doch auch eingefügt.
Bei Excel-gut als Kenntniss-Level sollten dir die verwendeten Funktionen (SUMMEWENN, ZÄHLENWENN und SUMMENPRODUKT) doch vertraut sein.
Du muss bei SUMMENPRODUKT oder Matrix-Formeln mit WENN "nur" beachten, dass prüfende Ausdrücke wie (JAHR($H$8:$H$33)=O7) als Ergebnis eine Matrix von Werten 0=FALSCH oder 1=WAHR ergeben. Diese Werte werden dann mit den Werten der anderen Zellbereiche pro Zeile multipliziert und alle Zeilenergebnisse werden addiert. In der WENN-Matrixfunktion wird entsprechend das "dann" oder "sonst" Ergebnis in einer Matrix zurückgegeben.
Mir ist es jetzt ehrlich gesagt etwas zu umständlich/mühselig die das Jahr prüfenden Ausdrucke in den Formeln wegzulassen und die Formeln zu reduzieren auf SUMME(Zellbereich_Jahr) und ANZAHL(Zellbereich_Jahr) oder auch MIN(Zellbereich_Jahr) oder MAX(Zellbereich_Jahr).
Gruß
Franz
Anzeige
AW: Differenz durch Mittelwert in VBA
26.06.2012 16:10:37
Michael
Hallo Franz,
So war es nicht gemeint. Wie Excel und die Fkt funktionieren ist mir klar :). Ich konnte die Rechnung nur nicht reproduzieren. Mal sehen ob ich irgendwo einen Fehler habe in meiner Rechnung :).
Mal eine Andere Frage. Wenn ich anstatt Jahr_Gesamt über normiere das verwendete Jahr normiere wie müsste ich dies in VBA anpassen?
Danke.
VG
Michael
AW: Differenz durch Mittelwert in VBA
26.06.2012 17:06:58
fcs
Hallo Michael,
in den Functions, die normierte Werte über alle Jahre ermittelt gibt ja immer zuerst eine Zeile in der die X/Y-Werte für intJahr:=0 (also alle Jahre) ermittelt werden.
Diese Zeile kann dann rausfliegen.
Die Berechnung des Durchschnittswertes der Y-Werte für das Jahr muss du dann unter die Zeile verschieben, in der die X/Y-Werte für das Jahr ermittelt werden.
Gruß
Franz
Anzeige
AW: Differenz durch Mittelwert in VBA
26.06.2012 20:10:38
Michael
Hallo Franz,
Vielen Dank für deine Antwort. Wie gesgat hänge ich an folgender Rechnung fest:
Userbild
Ich habe mal versucht es an einem Beispiel deine Werte nachzuproduzieren. Das File kannst du hier finden:
https://www.herber.de/bbs/user/80744.xlsm
In L37 findest du mein Regebnis für diese Formel oben. So wie ich deine Logik verstehe sollte in O24 das gleiche Ergebnis stehen aber dieses ist komplett unterschiedlich von dem was ich erhalten würde. Mir scheint es das da einfach ein teilen durch MW_Alle fehlt oder täusche ich mich. D.h. aus der VBA Funktion kommt der gleiche Wert raus O10. Übersehe ich irgendwas bzw. stehe ich auf dem Schlauch?
Danke für die Hilfe.
VG
Michael
Anzeige
AW: Differenz durch Mittelwert in VBA
27.06.2012 14:59:10
fcs
Hallo Michael,
die Formel in O24 ist "=Runden(O19/O21;1)" = Summe_Delta_Y/(n-1) = 113,90/13 = 8,80.
In O24 hab ich einen normierten Wert ermittelt und O2 mit Mittelwert_Alle_Jahre/Mittelwert_Jahr multipliziert.
Dein Rechengang für die Summenformel im Formel-Bild ist korrekt. Allerdings hat dieser Wert für mich irgendwie keine Aussagekraft. Denn die Multiplikation bzw. Division der Jahresergebnisse mit einer Konstanten ändert beim Vergleichen der Ergebnisse ja nichts an der Tendenz der Aussage. Die Werte werden einfach nur kleiner oder größer.
Gruß
Franz
AW: Differenz durch Mittelwert in VBA
27.06.2012 23:05:33
Michael
Hallo Franz,
Danke für deine Antwort. Um diese Diskussion zu einem Ende zu bringen möchte ich einfach mein Beispiel in VBA einarbeiten:
Userbild
Wie genau könnte ich dies in VBA implementieren?
Danke für deine Hilfe.
VG
Michael
AW: Differenz durch Mittelwert in VBA
02.07.2012 08:55:49
Michael
Hallo Franz,
ich hatte mich mal mal versucht mein Beispiel in VBA umzusetzen aber leider ohne Erfolg. Ich bekomme als Fehler nur #Wert raus. Hier die Version:
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
Vielen Dank für deine Hilfe.
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