Function Integrate(func As String, var As String, a As Double, b As Double, rule As String) As Double
Dim i As Long, temp As Long
Dim n As Double, delta As Double, CumulativeArea As Double, coordinate As Double
Dim FunctionVal() As Variant
func = Trim(func)
func = Subst(func, var)
If a > b Then
temp = a
a = b
b = temp
End If
n = WorksheetFunction.Max(Int(b - a) * 200, 1000)
delta = (b - a) / n
ReDim FunctionVal(0 To n)
Select Case UCase(var)
Case Is = "X"
Select Case UCase(Left(rule, 1))
Case Is = "X" 'solid of revolution about x-axis
For i = 0 To n
coordinate = a + i * delta
FunctionVal(i) = (evalx(func, coordinate) ^ 2) * delta
CumulativeArea = CumulativeArea + FunctionVal(i)
Next i
Integrate = CumulativeArea * WorksheetFunction.Pi
Case Is = "Y" 'solid of revolution about y-axis
For i = 0 To n
coordinate = a + i * delta
FunctionVal(i) = Abs(evalx(func, coordinate) * coordinate * delta)
CumulativeArea = CumulativeArea + FunctionVal(i)
Next i
Integrate = CumulativeArea * 2 * WorksheetFunction.Pi
Case Is = "S" 'Integration using Simpson's Rule
For i = 0 To n
coordinate = a + i * delta
If (i = 0 Or i = n) Then
FunctionVal(i) = Abs(evalx(func, coordinate))
ElseIf i Mod 2 = 0 Then
FunctionVal(i) = 2 * Abs(evalx(func, coordinate))
Else
FunctionVal(i) = 4 * Abs(evalx(func, coordinate))
End If
CumulativeArea = CumulativeArea + FunctionVal(i)
Next i
Integrate = (delta / 3) * CumulativeArea
Case Is = "T" 'Integration using the Trapezoid Rule
For i = 0 To n
coordinate = a + i * delta
If (i = 0 Or i = n) Then
FunctionVal(i) = Abs(evalx(func, coordinate))
Else
FunctionVal(i) = 2 * Abs(evalx(func, coordinate))
End If
CumulativeArea = CumulativeArea + FunctionVal(i)
Next i
Integrate = (delta / 2) * CumulativeArea
Case Is = "M" 'Integration using the Midpoint Rule
For i = 0 To (n - 1)
coordinate = ((a + i * delta) + (a + (i + 1) * delta)) / 2
FunctionVal(i) = Abs(evalx(func, coordinate))
CumulativeArea = CumulativeArea + FunctionVal(i)
Next i
Integrate = delta * CumulativeArea
Case Else
Integrate = CVErr(xlErrValue)
End Select
Case Is = "Y"
Select Case UCase(Left(rule, 1))
Case Is = "X" 'solid of revolution about x-axis
For i = 0 To n
coordinate = a + i * delta
FunctionVal(i) = Abs(evaly(func, coordinate) * coordinate * delta)
CumulativeArea = CumulativeArea + FunctionVal(i)
Next i
Integrate = CumulativeArea * 2 * WorksheetFunction.Pi
Case Is = "Y" 'solid of revolution about y-axis
For i = 0 To n
coordinate = a + i * delta
FunctionVal(i) = (evaly(func, coordinate) ^ 2) * delta
CumulativeArea = CumulativeArea + FunctionVal(i)
Next i
Integrate = CumulativeArea * WorksheetFunction.Pi
Case Is = "S" 'Integration using Simpson's Rule
For i = 0 To n
coordinate = a + i * delta
If (i = 0 Or i = n) Then
FunctionVal(i) = Abs(evaly(func, coordinate))
ElseIf i Mod 2 = 0 Then
FunctionVal(i) = 2 * Abs(evaly(func, coordinate))
Else
FunctionVal(i) = 4 * Abs(evaly(func, coordinate))
End If
CumulativeArea = CumulativeArea + FunctionVal(i)
Next i
Integrate = (delta / 3) * CumulativeArea
Case Is = "T" 'Integration using the Trapezoid Rule
For i = 0 To n
coordinate = a + i * delta
If (i = 0 Or i = n) Then
FunctionVal(i) = Abs(evaly(func, coordinate))
Else
FunctionVal(i) = 2 * Abs(evaly(func, coordinate))
End If
CumulativeArea = CumulativeArea + FunctionVal(i)
Next i
Integrate = (delta / 2) * CumulativeArea
Case Is = "M" 'Integration using the Midpoint Rule
For i = 0 To (n - 1)
coordinate = ((a + i * delta) + (a + (i + 1) * delta)) / 2
FunctionVal(i) = Abs(evaly(func, coordinate))
CumulativeArea = CumulativeArea + FunctionVal(i)
Next i
Integrate = delta * CumulativeArea
Case Else
Integrate = CVErr(xlErrValue)
End Select
Case Else
End Select
End Function
Function Derivative(func As String, var As String, a As Double, Optional b As Double) As Double
Const h = 0.001
Dim n1 As Double, n2 As Double
Dim term1 As Double, term2 As Double, term3 As Double, term4 As Double
func = Subst(func, var)
Select Case UCase(var)
Case Is = "X"
n1 = (evalx(func, a + (h / 2)) - evalx(func, a - (h / 2))) / h
n2 = (evalx(func, a + h) - evalx(func, a - h)) / (2 * h)
Derivative = (4 * n1 - n2) / 3
Case Is = "Y"
n1 = (evaly(func, a + (h / 2)) - evaly(func, a - (h / 2))) / h
n2 = (evaly(func, a + h) - evaly(func, a - h)) / (2 * h)
Derivative = (4 * n1 - n2) / 3
Case Is = "XY"
term1 = evalxy(func, a + h, b + h)
term2 = evalxy(func, a + h, b - h)
term3 = evalxy(func, a - h, b + h)
term4 = evalxy(func, a - h, b - h)
Derivative = ((term1 - term2) - (term3 - term4)) / (4 * h ^ 2)
Case Else
Derivative = CVErr(xlErrValue)
End Select
End Function
Function evalx(funct As String, xx As Double) As Double
x = xx
evalx = Evaluate(funct)
End Function
Function xval()
xval = x
End Function
Function evaly(funct As String, yy As Double) As Double
y = yy
evaly = Evaluate(funct)
End Function
Function yval()
yval = y
End Function
Function evalxy(funct As String, xx As Double, yy As Double) As Double
x = xx
y = yy
evalxy = Evaluate(funct)
End Function
Function Subst(func As String, var As String) As String
Select Case UCase(var)
Case "X"
With Application.WorksheetFunction
func = .Substitute(LCase(func), "x", "xval()")
func = .Substitute(LCase(func), "exval()", "ex") '(1)
func = .Substitute(LCase(func), "xval()irr", "xirr")
func = .Substitute(LCase(func), "xval()npv", "xnpv")
func = .Substitute(LCase(func), "sumxval()", "sumx") '(2)
func = .Substitute(LCase(func), "maxval()", "max") '(3)
func = .Substitute(LCase(func), "steyxval()", "steyx")
End With
Subst = func
Case "Y"
With Application.WorksheetFunction
func = .Substitute(LCase(func), "y", "yval()")
func = .Substitute(LCase(func), "dayval()", "day")
func = .Substitute(LCase(func), "yval()ield", "yield")
func = .Substitute(LCase(func), "syval()d", "syd")
func = .Substitute(LCase(func), "yval()ear", "year")
func = .Substitute(LCase(func), "hyval()p()", "hyp")
func = .Substitute(LCase(func), "steyval()x", "steyx")
func = .Substitute(LCase(func), "besselyval()", "bessely")
func = .Substitute(LCase(func), "frequencyval()", "frequency")
func = .Substitute(LCase(func), "sumx2myval()2", "sumx2my2")
func = .Substitute(LCase(func), "sumx2pyval()2", "sumx2py2")
func = .Substitute(LCase(func), "sumxmyval()2", "sumxmy2")
End With
Subst = func
Case "XY"
With Application.WorksheetFunction
func = .Substitute(LCase(func), "x", "xval()")
func = .Substitute(LCase(func), "exval()", "ex") '(1)
func = .Substitute(LCase(func), "xval()irr", "xirr")
func = .Substitute(LCase(func), "xval()npv", "xnpv")
func = .Substitute(LCase(func), "sumxval()", "sumx") '(2)
func = .Substitute(LCase(func), "maxval()", "max") '(3)
func = .Substitute(LCase(func), "steyxval()", "steyx")
End With
With Application.WorksheetFunction
func = .Substitute(LCase(func), "y", "yval()")
func = .Substitute(LCase(func), "dayval()", "day")
func = .Substitute(LCase(func), "yval()ield", "yield")
func = .Substitute(LCase(func), "syval()d", "syd")
func = .Substitute(LCase(func), "yval()ear", "year")
func = .Substitute(LCase(func), "hyval()p()", "hyp")
func = .Substitute(LCase(func), "steyval()x", "steyx")
func = .Substitute(LCase(func), "besselyval()", "bessely")
func = .Substitute(LCase(func), "frequencyval()", "frequency")
func = .Substitute(LCase(func), "sumx2myval()2", "sumx2my2")
func = .Substitute(LCase(func), "sumx2pyval()2", "sumx2py2")
func = .Substitute(LCase(func), "sumxmyval()2", "sumxmy2")
End With
Subst = func
Case Else
Subst = CVErr(xlErrValue)
End Select
End Function