GROWTH / Exponentielle Regression dynamisch ermitteln
17.02.2024 22:45:41
Michel44
ich würde gerne zu einem Datum in Zelle B1 das Makro mittels der Funktions GROWTH eine exponentielle Regression durchführen lassen.
Die bekannten X-Werte der GROWTH-Funktion sollen der Spalte D entnommen werden. In dieser befinden sich absteigend sortiert ca. 8600 Datumsangaben.
Als erster Wert der bekannten X-Werte soll das jüngste Datum (Eintrag in der untersten befüllten Zelle in Spalte D) genommen werden. Als letzter Wert soll das Datum aus Zelle B1 genommen werden. Die bekannten Y-Werte sollen der Spalte E entnommen werden und dem Bereich der bekannten X-Werte entsprechen, nur um eins nach rechts versetzt.
Das dritte Argument von GROWTH ist das Datum, für den der ensprechende Y-Wert ermittelt werden soll.
Letzterer soll vom Makro dann in die Zelle B2 geschrieben werden.
Leider macht GROWTH bei mir Probleme. Ich erhalte bei der Zeile, in der diese Funktion steht, immer den Fehler: Laufzeitfehler 1004: Die Growth-Eigenschaft des WorksheetFunction-Objektes kann nicht zugeordnet werden.
Ich wäre sehr dankbar, wenn mir jemand helfen kann.
Grüße
Michel
Hier die Beispieldatei inklusive allem:
https://www.herber.de/bbs/user/167122.xlsm
.... und hier der Code:
Sub Berechne_Growth()
Dim ws As Worksheet
Dim TestDatum As Date
Dim FoundRow As Long
Dim GrowthWert As Double
Dim LastRowD As Long
Dim i As Long
' Definiere das Arbeitsblatt
Set ws = ThisWorkbook.Sheets("Eingabe_Ausgabe")
' Lese das Testdatum aus Zelle B1
TestDatum = ws.Range("B1").Value
' Bestimme das letzte befüllte Datum in Spalte D
LastRowD = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
' Suche das Testdatum in Spalte D
For i = 2 To LastRowD
If ws.Cells(i, "D").Value = TestDatum Then
FoundRow = i
Exit For
End If
Next i
' Wenn das Testdatum nicht gefunden wurde, breche ab
If FoundRow = 0 Then
MsgBox "Das Testdatum wurde nicht gefunden."
Exit Sub
End If
' Ermittle den Bereich der Known_x-Werte (Spalte D)
Dim rngKnownX As Range
Set rngKnownX = ws.Range(ws.Cells(i, "D"), ws.Cells(LastRowD, "D"))
' Ermittle den Bereich der Known_y-Werte (Spalte E)
Dim rngKnownY As Range
Set rngKnownY = ws.Range(ws.Cells(i, "E"), ws.Cells(LastRowD, "E"))
' Berechne den Growth-Wert mit der GROWTH-Funktion
GrowthWert = WorksheetFunction.Growth(rngKnownY, rngKnownX, TestDatum)
' Fülle den Growth-Wert in Zelle B2 ein
ws.Range("B2").Value = GrowthWert
End Sub
