5852 views

Skip to first unread message

Mar 5, 2003, 2:05:47 PM3/5/03

to

I'm getting a fair number of requests for the following code; seems

approriate, in my circumstances, to post it.

approriate, in my circumstances, to post it.

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

Jan 10, 2005, 1:47:13 PM1/10/05

to

Hi Dave,

My name is Dave also. Hope you are having a good day. I am trying to

accomplish a task in Excel and was referred here and to you by Ron

Rosenfeld, while using the Excel Programming News Group. First I will

thank you for your time and efforts, which when I look at what you have

done is already considerable. Then I will confess that it has been a

long time since I studied stats.

I have what is a fairly simple set of data, a Date and an Adj Close*,

which is data assocated with the Dow Jones Averages. The data looks

like this:

Date Adj. Close*

01/03/05 10729.43

12/27/04 10776.13

12/20/04 10661.6

......More data

The data is graphed and a 6th Degree Polynomial Trend line is added to

the chart.

What I am trying to do is add to the data set is a data point

associated with the 6th Degree Polynomial Trend line, so the data would

look something like this:

Date Adj. Close* Trend

01/03/05 10729.43 10750.20(these are guesses, just for example,

but what I am trying to calculate)

12/27/04 10776.13 10751.23

12/20/04 10661.6 10680.00

......More data

Like I said, it has been a long time since I have studied stats. I

don't know that it is possible to do this, but it seems that creating a

table that caculates the trend number for the particular Date and Adj.

Close would be possible. I have tried several of the Excel functions

but do not get numbers that approximate the "Trend Numbers." I have

tried:

=LINEST(A2:A314,B2:B314) and get: -.2682

then the formula supplied with the chart:

y = -6E-11^6 + 1E-05^5 - 1.2819^4 + 65247^3 - 2E+09^2 + 3E+13x - 2E+17

and I get some thing like

-445,236,000,000,000,000

I also tried Forecast and Trend, neither of which came close to what

the Trend Line indicated as reasonable. I am at a loss. If you have the

time to shed some light on this, I would appreciate it.

My name is Dave also. Hope you are having a good day. I am trying to

accomplish a task in Excel and was referred here and to you by Ron

Rosenfeld, while using the Excel Programming News Group. First I will

thank you for your time and efforts, which when I look at what you have

done is already considerable. Then I will confess that it has been a

long time since I studied stats.

I have what is a fairly simple set of data, a Date and an Adj Close*,

which is data assocated with the Dow Jones Averages. The data looks

like this:

Date Adj. Close*

01/03/05 10729.43

12/27/04 10776.13

12/20/04 10661.6

......More data

The data is graphed and a 6th Degree Polynomial Trend line is added to

the chart.

What I am trying to do is add to the data set is a data point

associated with the 6th Degree Polynomial Trend line, so the data would

look something like this:

Date Adj. Close* Trend

01/03/05 10729.43 10750.20(these are guesses, just for example,

but what I am trying to calculate)

12/27/04 10776.13 10751.23

12/20/04 10661.6 10680.00

......More data

Like I said, it has been a long time since I have studied stats. I

don't know that it is possible to do this, but it seems that creating a

table that caculates the trend number for the particular Date and Adj.

Close would be possible. I have tried several of the Excel functions

but do not get numbers that approximate the "Trend Numbers." I have

tried:

=LINEST(A2:A314,B2:B314) and get: -.2682

then the formula supplied with the chart:

y = -6E-11^6 + 1E-05^5 - 1.2819^4 + 65247^3 - 2E+09^2 + 3E+13x - 2E+17

and I get some thing like

-445,236,000,000,000,000

I also tried Forecast and Trend, neither of which came close to what

the Trend Line indicated as reasonable. I am at a loss. If you have the

time to shed some light on this, I would appreciate it.

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

Jan 10, 2005, 1:49:51 PM1/10/05

to

Sorry but I forgot to mention that I am new to Google Groups and just

got a user name, etc., so I anot even ceratin I can get back to this

spot. I did save it to my favorites.

got a user name, etc., so I anot even ceratin I can get back to this

spot. I did save it to my favorites.

Thanks again

Jan 10, 2005, 6:36:35 PM1/10/05

to

There are a lot of Dave's who hang around these groups.

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

Nov 16, 2017, 11:21:31 PM11/16/17

to

Const cFirstNumPos = 5 ' pos. of first integer in displayed eqn

Const cMaxFormat = "0.00000000000000E+00"

Sub DetermineTrendlineCoefficients()
Const cMaxFormat = "0.00000000000000E+00"

Dim vSheet

Dim vSeries

Dim vTL

Dim vCht

vSheet = "CONTROLROOM"

vCht = 29

vSeries = "EnergyVector"

vTL = "S&P" & " Trendline 1"

A = TLcoef(vSheet, vCht, vSeries, vTL)

End Sub

Function TLcoef(vSheet, vCht, vSeries, vTL)

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)

HanErr:
On Error GoTo HanErr

Set o = Sheets(vSheet).ChartObjects(vCht).Chart. _

SeriesCollection(vSeries).Trendlines(vTL)

TLcoef = ExtractCoef(o, cFirstNumPos)

TLcoef = CVErr(xlErrValue)

MsgBox TLcoef

End Function

Function TLeval(vX, vSheet, vCht, vSeries, vTL)

Function TLeval(vX, vSheet, vCht, vSeries, vTL)

Dim o As Trendline, vRet

Application.Volatile
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
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

lCurPos = InStr(s, "x")

If lCurPos = 0 Then

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)
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 + 1) = Mid(s, lCurPos + 1)

End If

ExtractCoef = v

End Function

ExtractCoef = v

End Function

Feb 23, 2018, 2:03:20 AM2/23/18

to

Is it work? Can somebody provide xls example file with such a thing? Thx

Reply all

Reply to author

Forward

0 new messages

Search

Clear search

Close search

Google apps

Main menu