Benutzerdefinierte Funktion

Hallo,
ich habe eine Frage und es wäre super, wenn ihr weiter helfen könntet!
Eigentlich habe ich genau das schon gefunden, was ich suche:
http://www.excelformeln.de/formeln.html?welcher=373
Ich möchte x-Werte und dazugehörige y-Werte vorgeben sowie ein neues x. Für dieses neue x sollen nun die zwei darum liegenden x-Werte gesucht werden und zwischen den beiden entsprechenden y-Werten linear interpoliert werden. Die Lösung von der angegebenen Seite funktioniert perfekt.
Allerdings habe ich jetzt die Aufgabe bekommen, dies als benutzerdefinierte Funktion zu schreiben.
Man soll also in eine Zelle "=Interpolation(xWerte, yWerte, neuesX)" schreiben können und dann sollen die Schritte automatisch durchgeführt werden.
Ich bin so weit (und mir ist klar, dass es so nicht funktionieren kann):

Function Interpolation(xWerte As Variant, yWerte As Variant, neuesX As Variant) As Variant
'Diese Funktion interpoliert für die Stelle x den entsprechenden Wert y mit den Wertereihen  _
xWerte und yWerte
Dim UntergrenzeX, ObergrenzeX, UntergrenzeY, ObergrenzeY As Double
UntergrenzeX = Max(If(xWerte = neuesX, xWerte))
Interpolation = WENNFEHLER(Index(yWerte, VERGLEICH(neuesX, xWerte, 0)), ((neuesX - Untergrenze)  _
* Index(yWerte, VERGLEICH(Obergrenze, xWerte, 0)) + Abs(neuesX - Obergrenze) * Index(yWerte, VERGLEICH(Untergrenze, xWerte, 0))) / (Obergrenze - Untergrenze))
End Function

Ich habe aber leider keine Ahnung, wie ich das in dieser Funktion schreiben muss, damit es funktioniert.
Ich hatte auch schon den Ansatz mit
Range("A1").FormulaArray="=Max(If(xWerte allerdings kann ich ja innerhalb von einer Funktion keine anderen Zellen beschreiben (in die ich diese Hilfswerte schreiben könnte).
Vielen Dank schon mal für eure Hilfe!

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Function ev(wert As Range, such As Range) Dim xu, a, w Stop w = wert.Value xu = Application.Match(w, such, 1) a = such(xu).Resize(2, 2) ev = ((w - a(1, 1)) * a(2, 2) + (a(2, 1) - w) * a(1, 2)) / _ (a(2, 1) - a(1, 1)) End Function

Function Interpolation(neuesX As Range, xWerte As Range, yWerte As Range) Dim xu, a, b, w w = neuesX.Value xu = Application.Match(w, xWerte, 1) a = xWerte(xu).Resize(2, 1) b = yWerte(xu).Resize(2, 1) Interpolation = ((w - a(1, 1)) * b(2, 1) + (a(2, 1) - w) * b(1, 1)) / (a(2, 1) - a(1, 1)) End Function

Function I_Neu(neuesX As Range, xWerte As Range, yWerte As Range) Dim xu&, a, b, w, a1, b1, a2, b2, z1&, z2&, w1, w2 w = neuesX.Value a = xWerte: b = yWerte w1 = w - 100: w2 = w + 100 For xu = 1 To UBound(a) If a(xu, 1) w1 Then z1 = xu: w1 = a(xu, 1) Else If a(xu, 1)

Beliebteste Forumthreads (12 Monate)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread