Zurück zur Homepage

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 DoubleByVal sFuncText As StringAs 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