Funktionen berechnen.
Beispieldatei (Funktionen.zip 16 kB)
Um eine Funktion grafisch darzustellen, muss man einige X-Werte in die Funktion
einsetzen und die ermittelten Koordinaten in einem Diagramm darstellen.
Das kann man mit Excel sehr schön machen, es ist aber immer etwas mühselig,
bei jeder Funktionsänderung die Formeln anzupassen. Die vorliegende benutzerdefinierte
Funktion macht die Sache etwas einfacher. Sie bekommt als ersten Parameter den
X-Wert und als zweiten die Funktion als Text übergeben. Der Buchstabe X
in der übergebenen Funktion wird automatisch durch den übergebenen
X-Wert ersetzt und das Ergebnis als Funktionsergebnis zurückgeliefert.
Ein eventuell fehlendes Malzeichen (*) vor der Variablen X (z.B. bei 2x) wird
vor dem Berechnen eingesetzt. Eine Wurzel muss als Potenz eingegeben werden,
zum Beispiel 4^1/2=2 für die zweite Wurzel aus 4.
In der Beispielmappe kann in Zelle E3 die erste Funktion und in E4 die zweite
eingegeben werden.
Beispiel: 40+1,3x-3x^2+2x^3
In E5 wird X-Min und E6 X-Max eingetragen. Jeweils 100 Werte im Intervall werden
errechnet und als Diagramm dargestellt.
Option Explicit
Sub test()
MsgBox ParseFunktion(-3.6, "x^2+4x+(3+7)*3")
End Sub
Public Function ParseFunktion(x As Double, ByVal sFuncText As String) As Double
Dim lPos As Long, sZeichen As String
Dim sWertX As String, sErsatz As String
Application.Volatile
On Error Resume Next
sFuncText = WorksheetFunction.Substitute(sFuncText, ",", ".")
sWertX = "(" & WorksheetFunction.Substitute(CStr(x), ",", ".") & ")"
lPos = InStr(1, sFuncText, "X", vbTextCompare)
Do While lPos > 0
sErsatz = sWertX
If lPos > 1 Then
sZeichen = Mid(sFuncText, lPos - 1, 1)
If IsNumeric(sZeichen) Or (sZeichen = ")") Then
sErsatz = "*" & sWertX
End If
End If
sFuncText = Left(sFuncText, lPos - 1) & sErsatz & _
Right(sFuncText, Len(sFuncText) - lPos)
lPos = lPos + Len(sErsatz)
lPos = InStr(lPos, sFuncText, "X", vbTextCompare)
Loop
lPos = InStr(1, sFuncText, "(", vbTextCompare)
sErsatz = "*("
Do While lPos > 0
If lPos > 1 Then
sZeichen = Mid(sFuncText, lPos - 1, 1)
If IsNumeric(sZeichen) Then
sFuncText = Left(sFuncText, lPos - 1) & sErsatz & _
Right(sFuncText, Len(sFuncText) - lPos)
End If
End If
lPos = lPos + Len(sErsatz)
lPos = InStr(lPos, sFuncText, "(", vbTextCompare)
Loop
ParseFunktion = Application.Evaluate("=" & sFuncText)
End Function