Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1276to1280
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Funktion zum Berechnen in VBA gibt keinen Wert aus

Funktion zum Berechnen in VBA gibt keinen Wert aus
Michael
Hallo Experten,
ich wollte folgendes Berechnen:
x = 1/n * Summe (x_{i}-x_{i-1})/x_{i-1}
Ich habe im folgenden Excel mein Problem mal visualisiert:
https://www.herber.de/bbs/user/81549.xlsm
Es geht um die folgende Funktion:
Option Explicit
Private objX() As Variant, objY() As Variant, lngCount As Long Function RatioMean(strSheet As String) Dim dblSumAverageReturn As Double Dim dblAverageReturn As Double Dim varElement As Variant For varElement = 1 To lngCount - 1 dblSumAverageReturn = dblSumAverageReturn + (objY(varElement + 1) - objY(varElement)) / _ objY(varElement) Next dblAverageReturn = dblSumAverageReturn / lngCount End Function
Sub prcDatenObjekt_erzeugen(ByVal strSheet As String)
Dim arrX, lngX As Long
With Sheets(strSheet)
arrX = .Cells(5, 2).Resize(Application.WorksheetFunction.Count(.Range(.Cells(5, 2), _
.Cells(Rows.Count, 1).End(xlUp))))
End With
lngCount = 0
For lngX = LBound(arrX) To UBound(arrX)
lngCount = lngCount + 1
ReDim Preserve objX(0 To lngCount)
objX(lngCount) = arrX(lngX, 1) * 1
Next lngX
End Sub
Danke für die Hilfe.
Viele Grüße,
Michael

AW: Funktion zum Berechnen in VBA gibt keinen Wert aus
23.08.2012 23:21:50
Josef

Hallo Michael,
1. Hat deine Funktion keinen Rückgabewert.
2. Greift die Funktion auf ein Datenfeld zu das aber gar nicht gefüllt wird.
3. solltest du vielleicht verständlich beschreiben, was du berechnen willst.

« Gruß Sepp »

AW: Funktion zum Berechnen in VBA gibt keinen Wert aus
23.08.2012 23:38:02
Michael
Hallo Sepp,
Danke für deine Antwort. Die Funktion liefert einfach eine 0. Ich habe einen Test gemacht (siehe neues angehängtes Excel, https://www.herber.de/bbs/user/81551.xlsm) einmal den Wert per Hand auszurechnen und einmal per Funktion. Leider stimmen die Werte nicht überein weil beim manuellen Berechnen ein Wert rauskommt bei der Funktion wie gesagt 0. Das Datenfeld ist gefüllt. Was ich berechnen will ist immer noch die gleiche Funktion wie anfangs beschrieben:
Gesamt = 1/n * (Summe (x_{i}-x_{i-1})/x_{i-1})
Ich habe ein wenig an der Funktion gebastelt aber ohne Erfolg.
Option Explicit
Private objX() As Variant, objY() As Variant, lngCount As Long
Function RatioMean(strSheet As String)
Dim dblSumAverageReturn As Double
Dim dblAverageReturn As Double
Dim varElement As Variant
Call prcDatenObjekt_erzeugen(strSheet:=strSheet)
For varElement = 1 To lngCount - 1
dblSumAverageReturn = dblSumAverageReturn + (objY(varElement + 1) - objY(varElement)) /  _
objY(varElement)
Next
dblAverageReturn = dblSumAverageReturn / lngCount
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
Ich hoffe ich habe dir alle Fragen beantwortet?
Vielen Dank.
Viele Grüße,
Michael

Anzeige
AW: Funktion zum Berechnen in VBA gibt keinen Wert aus
24.08.2012 05:02:43
Luschi
Hallo Michael,
ändere die Funktion so:

Function RatioMean(strSheet As String) As Double Dim dblSumAverageReturn As Double Dim dblAverageReturn As Double Dim varElement As Variant Call prcDatenObjekt_erzeugen(strSheet:=strSheet) For varElement = 1 To lngCount - 1 dblSumAverageReturn = dblSumAverageReturn + (objY(varElement + 1) - objY(varElement)) / objY(varElement) Next RatioMean = dblSumAverageReturn / lngCount Erase objX, objY End Function

Grup von Luschi
aus klein-Paris

Anzeige
AW: Funktion zum Berechnen in VBA gibt keinen Wert aus
24.08.2012 08:44:24
Michael
Hallo Luschi,
Danke genau das hatte ich gesucht :). Wie konnte ich das übersehen!
Viele Grüße,
Michael

AW: Funktion zum Berechnen in VBA gibt keinen Wert aus
24.08.2012 08:41:14
Josef

Hallo Michael,
Data

 ABCDEF
1      
2Messung1    
3      
4DatumWertRatioAverage ManuelAverage FunktionAverage Matrixformel
511.07.12100,734    
612.07.12100,750,000159-0,00010071853865-0,00010071853865-0,00010071853865
713.07.12100,770,000199   
816.07.12100,7820,000119   
917.07.12100,7820   
1018.07.12100,7-0,00081   
1119.07.12100,719,93E-05   

Formeln der Tabelle
ZelleFormel
D6=MITTELWERT(C6:C35)
E6=RatioMean(B5:B35)
F6{=MITTELWERT((B6:B35-B5:B34)/B5:B34)}
Enthält Matrixformel:
Umrandende
{ } nicht miteingeben,
sondern Formel mit STRG+SHIFT+RETURN abschließen!
Matrix verstehen


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
Function RatioMean(Bereich As Range) As Variant
  Dim strR1 As String, strR2 As String
  
  On Error GoTo ErrExit
  
  If Bereich.Rows.Count < 2 Or Bereich.Columns.Count > 1 Then
    RatioMean = CVErr(xlErrRef)
    Exit Function
  End If
  
  strR1 = Bereich(2, 1).Resize(Bereich.Rows.Count - 1, 1).Address
  strR2 = Bereich(1, 1).Resize(Bereich.Rows.Count - 1, 1).Address
  
  'Rückgabewert!
  RatioMean = Evaluate("AVERAGE((" & strR1 & "-" & strR2 & ")/" & strR2 & ")")
  
  Exit Function
  
  ErrExit:
  RatioMean = CVErr(xlErrValue)
End Function



« Gruß Sepp »

Anzeige
AW: Funktion zum Berechnen in VBA gibt keinen Wert aus
24.08.2012 10:00:36
Michael
Hallo Sepp,
Danke für deine Antwort. Was ist der Vorteil es so zu machen wie du es vorschlägst?
Viele Grüße,
Michael

AW: Funktion zum Berechnen in VBA gibt keinen Wert aus
24.08.2012 10:03:19
Josef

Hallo Michael,
ersten braucht es für eine so simple Berechnung meiner Meinung nach keine UDF.
Wenn schon UDF, dann sollte man dieser auch die entsprechenden Parameter (in diesem Fall den Zellbereich) direkt übergeben.

« Gruß Sepp »

Anzeige
AW: Funktion zum Berechnen in VBA gibt keinen Wert aus
24.08.2012 10:17:25
Michael
Hallo Sepp,
Super Danke für die Antwort :).
VG,
Michael

AW: Funktion zum Berechnen in VBA gibt keinen Wert aus
24.08.2012 11:23:50
Michael
Hallo nochmal,
ich habe mich für meine Version der Funktion entschieden, da es etwas komplexer wird und ich später noch eine Abfrage auf verschiedene Uhrzeiten machen muss (Dazu brauche ich später etwas mehr Hilfe :) ). Aber es stellt sich gerade ein neues Problem dar. Ich versuche am Ende aus meiner Prozentualen Zahl einen Wert zu berechnen. Dazu brauche ich den letzten Wert in meiner Tabelle. Leider gestaltet sich das schwierig und ich erhalte eine Fehlermeldung Invalid qualifier :(. Die erweiterte Funktion ist unten dargestellt. Die Stellen die nicht funktionieren oder neu dabei sind, sind in Bold dargestellt.
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.End(xlUp).Value
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
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
Danke für die Hilfe.
VG,
Michael

Anzeige
AW: Funktion zum Berechnen in VBA gibt keinen Wert aus
24.08.2012 11:36:49
Josef

Hallo Michael,
ich glaube, du hast dich da mit deinem Level etwas übernommen.
GetLastValue = objY(UBound(objy))


« Gruß Sepp »

AW: Funktion zum Berechnen in VBA gibt keinen Wert aus
24.08.2012 11:47:21
Michael
Super Danke! Das habe ich gesucht. Versuche etwas besser zu werden und man lernt immer von VBA Experten wie du es bit einfach dazu :)
Anzeige

305 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige