AW: Zwar nicht das was ich suche
22.09.2004 12:15:31
ANdreas
Hallo Otmar,
VBA ist doch nichts böses ;-)
den Y-Wert der Wertepaare berechnest Du doch über eine Funktion, oder nicht?
Hier mal nen Vorschlag über eine VBA-Funktion das ganze anzunähern:
In Zelle B1 steht die Formel (Bezug ohne $), z.B.:
=A1*A1-5*A1+1
In Zelle B2 berechnen wir näherungsweise bis auf z.B. 0,000001 genau eine Nullstelle im Intervall von 0 bis 1 (Dieses Intervall kannst Du natürlich auch aus deinen Wertepaaren mit einer Formel an die Funktion übergeben)
=Y0Naeherung(B1;A1;0;1;0,000001)
In einem Standardmodul sollte dazu dieses Makro stehen - es "sucht" mit Hilfe der Intervallhalbierung eine Annäherung an die Nullstelle:
Private Function YWert(rngFunktion As Range, rngXWert As Range, dblXWert#) As Double
On Error GoTo ErrorHandler
YWert = Application.Evaluate( _
Replace(rngFunktion.Formula, rngXWert.Address(0, 0), Replace(dblXWert, ",", ".")))
On Error GoTo 0
Exit Function
ErrorHandler:
MsgBox Err.Description
Exit Function
End Function
Function Y0Naeherung(rngFunktion As Range, rngXWert As Range, _
dblIntvU#, dblIntvO#, dblGenauigkeit#) As Variant
Dim dblMittelwert#, i&
Dim dblYIntvU#, dblYIntvO#, dblYMittelwert#
i = 0 'Zähler für Durchläufe
Do
i = i + 1
dblMittelwert = 0.5 * (dblIntvU + dblIntvO)
dblYIntvU = YWert(rngFunktion, rngXWert, dblIntvU)
dblYIntvO = YWert(rngFunktion, rngXWert, dblIntvO)
dblYMittelwert = YWert(rngFunktion, rngXWert, dblMittelwert)
If dblYIntvU * dblYMittelwert <= 0 Then 'Vorzeichenwechsel
dblIntvO = dblMittelwert
Else
If dblYIntvO * dblYMittelwert < 0 Then 'Vorzeichenwechsel
dblIntvU = dblMittelwert
Else
If Abs(dblYIntvU) <= Abs(dblYIntvO) Then
dblIntvO = dblMittelwert
Else
dblIntvU = dblMittelwert
End If
End If
End If
Loop Until i > 1000 Or Abs(dblYMittelwert) <= dblGenauigkeit Or _
Abs(dblYIntvU) <= dblGenauigkeit Or Abs(dblYIntvO) <= dblGenauigkeit
If i > 1000 Then
Y0Naeherung = "Keine Annäherung an Nullstelle gefunden"
Else
If Abs(dblYMittelwert) <= dblGenauigkeit Then
Y0Naeherung = dblMittelwert
Else
If Abs(dblYIntvU) <= dblGenauigkeit Then
Y0Naeherung = dblYIntvU
Else
Y0Naeherung = dblYIntvO
End If
End If
End If
End Function
Hoffe das hilft weiter,
Andreas