curve fit equation

R

rcc

Hi,

Is there a fairly straight forward formula for retrieving curve fit
coefficients? I know how to find the equation when I do a curve fit in a
chart, but I'm looking for something I can automate with a macro.

Thanks!
rcc
 
N

Normek

Is this any good for you? It is one of my earlier attempts at Functions:

'
' GrfCurve Macro
' Macro recorded 7/2/2000 by Normek
' This function derives a polynomial regression using an Abbreviated Dolittle
' Algorithm to derive a quadratic equation of the form y = ax² + bx + c
' from x and y values obtained from the Excel spreadsheet and calculates the
' coefficients. Using these coefficients either y values can be found for
new x
' values or x values can be found for new y values by using the appropriate
equations.

'
Option Base 1 'Must be declared outside the function
Function GrfCurve(xrange, yrange, A_B_C_R_XorY, newXorY) 'The arguments
are obtained from the worksheet
On Error GoTo errorhandler
Dim sx As Range 'arrays must be declared as Range objects
Dim sy As Range
Dim ssb0 As Variant
Dim ssb1 As Variant
Dim ssb2 As Variant
Dim equatn
Set sx = xrange 'linking the range object to the worksheet
Set sy = yrange
If newXorY = " " Then
newXorY = "A1"
End If
Let XorY = A_B_C_R_XorY
If (XorY = "a" Or XorY = "A") Then
choice = 1
ElseIf (XorY = "b" Or XorY = "B") Then
choice = 2
ElseIf (XorY = "c" Or XorY = "C") Then
choice = 3
ElseIf (XorY = "r" Or XorY = "R") Then
choice = 4
ElseIf (XorY = "x" Or XorY = "X") Then
choice = 5
ElseIf (XorY = "y" Or XorY = "Y") Then
choice = 6
Else
Msg = "You have not entered the correct third argument. It should
one of A, B, C, R, X or Y"
MsgBox Msg, , "GrfCurve Function Argument Error"
Return
End If
Dim aarray(6, 4) 'declaring the internal Abbreviated Doolittle
algorithm matrix
aarray(1, 1) = Application.Count(sx) ' and filling it
aarray(1, 2) = Application.Sum(sx) ' Xcel functions require the
"Application."
aarray(1, 3) = Application.SumProduct(sx, sx) 'modifier in Visual Basic
aarray(1, 4) = Application.Sum(sy)
aarray(2, 2) = aarray(1, 2) / aarray(1, 1)
aarray(2, 3) = aarray(1, 3) / aarray(1, 1)
aarray(2, 4) = aarray(1, 4) / aarray(1, 1)
aarray(3, 1) = Application.SumProduct(sx, sy)
aarray(3, 2) = aarray(1, 3) - aarray(1, 2) * aarray(2, 2)
aarray(3, 3) = Application.SumProduct(sx, sx, sx) - aarray(1, 3) *
aarray(2, 2)
aarray(3, 4) = aarray(3, 1) - aarray(1, 4) * aarray(2, 2)
aarray(4, 3) = aarray(3, 3) / aarray(3, 2)
aarray(4, 4) = aarray(3, 4) / aarray(3, 2)
aarray(5, 3) = Application.SumProduct(sx, sx, sx, sx) - (aarray(2, 3) *
aarray(1, 3)) - (aarray(3, 3) * aarray(4, 3))
aarray(5, 4) = Application.SumProduct(sx, sx, sy) - (aarray(1, 4) *
aarray(2, 3)) - (aarray(3, 4) * aarray(4, 3))
aarray(6, 4) = aarray(5, 4) / aarray(5, 3)
ssb0 = aarray(1, 4) * aarray(2, 4)
ssb1 = aarray(3, 4) * aarray(4, 4)
ssb2 = aarray(5, 4) * aarray(6, 4)
aa = aarray(6, 4)
bb = aarray(4, 4) - aa * aarray(4, 3)
cc = aarray(2, 4) - bb * aarray(2, 2) - aa * aarray(2, 3)
RR = (ssb1 + ssb2 + ssb0) / (Application.SumProduct(sy, sy))
If choice = 1 Then
equatn = aa
ElseIf choice = 2 Then
equatn = bb
ElseIf choice = 3 Then
equatn = cc
ElseIf choice = 4 Then
equatn = RR * RR
ElseIf choice = 5 Then
equatn = (-bb + (bb * bb - 4 * aa * (cc - newXorY)) ^ 0.5) / (2 * aa)
ElseIf choice = 6 Then
equatn = aa * newXorY * newXorY + bb * newXorY + cc
End If
GrfCurve = equatn
Exit Function
errorhandler:
Resume Next
End Function
 
J

Jerry W. Lewis

You are working way to hard. LINEST will fit polynomials or any other
function that is linear in the unknown coefficients. For example the
worksheet array formula
=LINEST(ycolumn,xcolumn^{1,2})
fits a quadratic. In VBA, you can set up the appropriate x-matrix in arrays
and call WorksheetFunction.LinEst()

Jerry
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top