HTH
Dave Braden
=========
Option Explicit
'As J.W. Lewis has noted, Excel's Chart Trendline function yields
'exceptionally good values for the models it fits. In contrast to
'Excel's overall stats-capability, Trendline is a standout.
'
'These functions provide a quasi-dynamic link to a chart's *displayed*
'trendline to help avoid deficencies of Excel's LINEST.
'
'Function TLcoef(...) returns Trendline coefficients
'Function TLeval(x, ...) evaluates the current trendline at a given x
'
'To specify the arguments of TLcoef, and the last 4 of TLeval:
' vSheet is the name/number of the sheet containing the chart.
' I strongly recommend you use the text name appearing in the
sheet's tab
' vCht is the name/number of the chart. To see this, deselect the chart,
' then shift-click it; its name will appear in the drop-down list at
the left of
' the standard toolbar.
' If there is only one chart in the sheet, you can safely use just 1
as an
' argument.
' VSeries is a series name/number, and vTL is the series' trendline
number.
' Ideally you will have named the series, and refer to it by name.
' To determine its name/number, as well as the trendline number
needed
' for vTL, pass the mouse arrow over the trendline. Of course, if
there is only
' one series in the chart, you can set vSeries = 1, but beware if
you add
' more series to the chart.
'
'David J. Braden maintains this as an open-community effort. Plz post
or send
' suggestions to him.
'First draft written 2003 March 1 by D J Braden
'Current concern(s)
' (1) Because this is a function, we can't reliably get the underlying
trendline
' coefficients to greater accuracy than what is displayed. To get the
most
' accurate values, format the trendline label to Scientific notation
with 14
' decimal places. (Right-click the label to do this)
' (2) Even though the functions are volatile, you may have to do a
worksheet
' recalc to get things updated properly for anything changing the
chart to
' get passed through to these functions. :((
'********************************************************
Const cFirstNumPos = 5 ' pos. of first integer in displayed eqn
Const cMaxFormat = "0.00000000000000E+00"
Function TLcoef(vSheet, vCht, vSeries, vTL)
'Return coefficients of an Excel chart trendline, *to precision
displayed*
'
'Note: While Trendline seemingly always reports subsequent terms from
'a given one on, sometimes it reduces the order of the fit. So this
function
'returns, for a poly-fit, an array of length 1 + the order of the
requested fit,
' *not* the number of values displayed. The last value in the return
array
'is the constant term; preceeding values correspond to higher-order x.
Dim o As Trendline
Application.volatile
If ParamErr(TLcoef, vSheet, vCht, vSeries, vTL) Then Exit Function
On Error GoTo HanErr
Set o = Sheets(vSheet).ChartObjects(vCht).Chart. _
SeriesCollection(vSeries).Trendlines(vTL)
TLcoef = ExtractCoef(o, cFirstNumPos)
Exit Function
HanErr:
TLcoef = CVErr(xlErrValue)
End Function
Function TLeval(vX, vSheet, vCht, vSeries, vTL)
'DJ Braden
' Exp/logs are done for cases xlPower and xlExponential to allow
' for greater range of arguments.
Dim o As Trendline, vRet
Application.volatile
' If Not CheckNum(vX, TLeval) Then Exit Function
If ParamErr(TLeval, vSheet, vCht, vSeries, vTL) Then Exit Function
Set o =
Sheets(vSheet).ChartObjects(vCht).Chart.SeriesCollection(vSeries) _
.Trendlines(vTL)
vRet = ExtractCoef(o, cFirstNumPos)
Select Case o.Type
Case xlLinear
vRet(1) = vX * vRet(1) + vRet(2)
Case xlExponential 'see comment above
vRet(1) = Exp(Log(vRet(1)) + vX * vRet(2))
Case xlLogarithmic
vRet(1) = vRet(1) * Log(vX) + vRet(2)
Case xlPower 'see comment above
vRet(1) = Exp(Log(vRet(1)) + Log(vX) * vRet(2))
Case xlPolynomial
Dim l As Long
vRet(1) = vRet(1) * vX + vRet(2)
For l = 3 To UBound(vRet)
vRet(1) = vX * vRet(1) + vRet(l)
Next
End Select
TLeval = vRet(1)
Exit Function
HanErr:
TLeval = CVErr(xlErrValue)
End Function
Private Function ExtractCoef(o As Trendline, ByVal lLastPos As Long)
Dim lCurPos As Long, s As String
s = o.DataLabel.Text
If o.DisplayRSquared Then
lCurPos = InStr(s, "R")
s = Left$(s, lCurPos - 1)
End If
If o.Type <> xlPolynomial Then
ReDim v(1 To 2) As Double
If o.Type = xlExponential Then
s = Application.WorksheetFunction.Substitute(s, "x", "")
s = Application.WorksheetFunction.Substitute(s, "e", "x")
ElseIf o.Type = xlLogarithmic Then
s = Application.WorksheetFunction.Substitute(s, "Ln(x)", "x")
End If
lCurPos = InStr(1, s, "x")
If lCurPos = 0 Then
v(2) = Mid(s, lLastPos)
Else
v(1) = Mid(s, lLastPos, lCurPos - lLastPos)
v(2) = Mid(s, lCurPos + 1)
End If
Else 'have a polynomial
Dim lOrd As Long
ReDim v(1 To o.Order + 1) As Double
lCurPos = InStr(s, "x")
If lCurPos = 0 Then
v(o.Order + 1) = Mid(s, lLastPos)
Exit Function 'with single constant term
End If
'else
lOrd = Mid(s, lCurPos + 1, 1)
Do While lOrd > 1
v(UBound(v) - lOrd) = Mid(s, lLastPos, lCurPos - lLastPos)
lLastPos = lCurPos + 2
lCurPos = InStr(lLastPos, s, "x")
lOrd = lOrd - 1
Loop
'peel off coeffs. for affine terms in eqn
v(o.Order) = Mid(s, lLastPos, lCurPos - lLastPos)
v(o.Order + 1) = Mid(s, lCurPos + 1)
End If
ExtractCoef = v
End Function
Private Function ParamErr(v, ParamArray parms())
Dim l As Long
For l = LBound(parms) To UBound(parms)
If VarType(parms(l)) = vbError Then
v = parms(l)
ParamErr = True
Exit Function
End If
Next
End Function
--
ROT13 e-mail: qoe...@ebpurfgre.ee.pbz
It looks like your function:
Function TLeval(vX, vSheet, vCht, vSeries, vTL)
might do what I am thinking of, but I am not certain. It looks like
part of the code got cut off. I tried to copy it over to word and
figure out what arguments it needs and stuff, but I have not been able
to get through it. Thanks for your time and effort, I hope you have a
good day.
Sincerely,
David Lanman
who...@sbcglobal.net
Thanks again
Dave Braden is one:
http://google.co.uk/groups?threadm=dbraden-1C662A.14054705032003%40msnews.microsoft.com
(one line in your browser)
Maybe this is the Dave you were looking for.
--
Dave Peterson