Welcome to Bowdoin | Bowdoin College



'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'''''''''''''''''''''' ADVANCED EXCEL '''''''''''''''''''''

''''''''''' for scientific data analysis 2nd ed. '''''''''''

''''''''''''''''''''''' R. de Levie '''''''''''''''''''''''

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

''''''''''''***********************************''''''''''''

'''''''''''* *'''''''''''

''''''''''* SAMPLE FUNCTIONS & MACROS *''''''''''

'''''''''''* *'''''''''''

''''''''''''***********************************''''''''''''

''''''''''''''''''''''''''''''''''''''''''''(c) R. de Levie

'''''''''''''''''''''''''''''''''''''''''''' v 8, Aug. 2008

'

' The sample functions and macros listed here are those in

' chapters 1 through 11 of my book Advanced Excel for

' scientific data analysis, and are provided for the con-

' venience of those readers who prefer to download them

' rather than to type them in, a tedious and error-prone

' process. They are listed in the order in which they ap-

' pear in the text, and are identified by chapter and page

' number. For the sake of user convenience, some overlap

' with the MacroMorsels and MacroBundle is tolerated. In

' order to avoid possible confusion with routines of the

' same name, letters such as A, B, etc. have sometimes been

' added to the codes listed here. Wherever routines are il-

' lustrated in the text in separate sections, the preceding

' parts have been included in order to make the macros

' operable. Some of these routines, especially in the first

' few chapters, are not dimensioned, and therefore should

' NOT be used with Option Explicit.

'''''''''''''''''''''''''''''''''''''''' Chapter 1 page 37:

Sub MovieDemo1A()

' This sample will work only after the graph

' has been set up as described in the text

Range("A1") = 0

Range("A2") = 0

For i = 1 To 400

Range("A1") = 10 - 0.05 * Abs(i - 200)

Range("A2") = 10 * Exp(-0.001 * (i - 300) ^ 2)

Application.ScreenUpdating = True

Next i

Range("A1") = 0

Range("A2") = 0

End Sub

'''''''''''''''''''''''''''''''''''''''' Chapter 1 page 44:

Function Factorial(n)

'Illustration of a recursive function

If n XArray.Count - (m + 1) / 2 Then _

Row = XArray.Count - (m + 1) / 2

For i = Row - (m - 1) / 2 To Row + (m + 1) / 2

Term = 1

For j = Row - (m - 1) / 2 To Row + (m + 1) / 2

If i j Then Term = Term * _

(X - XArray(j)) / (XArray(i) - XArray(j))

Next j

Y = Y + Term * YArray(i)

Next i

Lagrange = Y

End Function

'''''''''''''''''''''''''''''''''''''''' Chapter 1 page 58:

Function EE(x)

Dim m As Integer

Dim sum As Double

Dim oldterm As Double, newterm As Double

m = 1

sum = 1

oldterm = 1

Do

newterm = -(2 * m - 1) * oldterm / (2 * x * x)

sum = sum + newterm

oldterm = newterm

m = m + 1

Loop Until Abs(newterm) < 0.00000001

EE = sum / (x * Sqr([Pi()]))

End Function

'''''''''''''''''''''''''''''''''''''''' Chapter 1 page 64:

Function Logarheads(x)

MsgBox "Log(" & x & ") = " & Log(x) & " but" & Chr(13) & _

"Application.Log(" & x & ") = " & Application.Log(x)

End Function

''''''''''''''''''''''''''''''''''''''' Chapter 4 page 193:

Sub BufferStrength()

' Computes the buffer strength B

' using first-order differencing.

' F is the proton function,

' H is the proton concentration, [H+].

Dim B As Double, Delta As Double

Dim vH As Double, vHm As Double, vHp As Double

Dim vF As Double, vFm As Double, vFp As Double

Dim rgH As Range, rgF As Range

Dim fA

Delta = 0.0000001

' Read F and H

Set rgF = Application.InputBox(Prompt:= _

"The proton function F is located in ", Type:=8)

rgF.Select

vF = rgF.Value

Set rgH = Application.InputBox(Prompt:= _

"The proton concentration is located in ", Type:=8)

rgH.Select

vH = rgHA.Value

fH = rgH.Formula

' Modify vH and read the corresponding values of vF

vHm = vH * (1 - Delta)

rgH.Select

Selection.Value = vHm

rgF.Select

vFm = rgF.Value

vHp = vH * (1 + Delta)

rgH.Select

Selection.Value = vHp

rgF.Select

vFp = rgF.Value

' Restore H

rgH.Select

Selection.Formula = fH

' Compute B = H*(dF/dH)

B = (vFp - vFm) / (2 * Delta)

' Write the result next to F

rgF.Select

Selection.Offset(0, 1).Select

Selection.Value = B

Selection.Offset(0, -1).Select

End Sub

''''''''''''''''''''''''''''''''''''''' Chapter 4 page 214:

Function S(x, amplitude, shift, a1, b1, c1, a2, b2, c2, _

a3, b3, c3, a4, b4, c4, a5, b5, c5, a6, b6, c6)

Dim T1 As Double, T2 As Double, T3 As Double

Dim T4 As Double, T5 As Double, T6 As Double

T1 = a1 / Exp(((x - c1 - shift) / b1) ^ 2)

T2 = a2 / Exp(((x – c2 - shift) / b2) ^ 2)

T3 = a3 / Exp(((x – c3 - shift) / b3) ^ 2)

T4 = a4 / Exp(((x – c4 - shift) / b4) ^ 2)

T5 = a5 / Exp(((x – c5 - shift) / b5) ^ 2)

T6 = a6 / Exp(((x – c6 - shift) / b6) ^ 2)

S = amplitude * (T1 + T2 + T3 + T4 + T5 + T6)

End Function

''''''''''''''''''''''''''''''''''''''' Chapter 4 page 217:

Function SA(x, amplitude, shift, a1, b1, c1, a2, b2, c2, _

a3, b3, c3, a4, b4, c4, a5, b5, c5, a6, b6, c6)

Dim T1 As Double, T2 As Double, T3 As Double

Dim T4 As Double, T5 As Double, T6 As Double

If ((x - c1 - aa) / b1) < 25 Then _

T1 = a1 / Exp(((x - c1 - aa) / b1) ^ 2) Else T1 = 0

If ((x - c2 - aa) / b2) < 25 Then _

T2 = a2 / Exp(((x - c2 - aa) / b2) ^ 2) Else T2 = 0

If ((x - c3 - aa) / b3) < 25 Then _

T3 = a3 / Exp(((x - c3 - aa) / b3) ^ 2) Else T3 = 0

If ((x - c4 - aa) / b4) < 25 Then _

T4 = a4 / Exp(((x - c4 - aa) / b4) ^ 2) Else T4 = 0

If ((x - c5 - aa) / b5) < 25 Then _

T5 = a5 / Exp(((x - c5 - aa) / b5) ^ 2) Else T5 = 0

If ((x - c6 - aa) / b6) < 25 Then _

T6 = a6 / Exp(((x - c6 - aa) / b6) ^ 2) Else T6 = 0

SA = amplitude * (T1 + T2 + T3 + T4 + T5 + T6)

End Function

''''''''''''''''''''''''''''''''''''''' Chapter 6 page 349:

Function Convol(Array1, Array2, Denom, N)

Dim i As Integer

Dim Sum As Double

Dim Array3 As Variant

ReDim Array3(1 To 2 * N)

For i = 1 To N

Array3(i) = Array2(N + 1 – i)

Next i

Sum = 0

For i = 1 To N

Sum = Sum + Array1(i – N + 1) * Array3(i)

Next i

Convol = Sum / Denom

End Function

''''''''''''''''''''''''''''''''''''''' Chapter 7 page 377:

Function siEulerA(k1, oldT1, oldT2, n, oldA) As Double

'semi-implicit Euler method for A

Dim a As Double, f As Double, step As Double

Dim i As Integer

n = CInt(n)

a = oldA

step = (oldT2 - oldT1) / n

f = (1 - k1 * step / 2) / (1 + k1 * step / 2)

For i = 1 To n

a = a * f

Next i

siEulerA = a

End Function

''''''''''''''''''''''''''''''''''''''' Chapter 7 page 378:

Function siEulerB _

(k1, k2, oldT1, oldT2, n, oldA, oldb) As Double

'semi-implicit Euler method for B

Dim a As Double, b As Double, step As Double

Dim f As Double, fA As Double, fB As Double

Dim i As Integer

n = CInt(n)

a = oldA

b = oldb

step = (oldT2 - oldT1) / n

f = (1 - k1 * step / 2) / (1 + k1 * step / 2)

fA = k1 * step / ((1 + k1 * step / 2) _

* (1 + k2 * step / 2))

fB = (1 - k2 * step / 2) / (1 + k2 * step / 2)

For i = 1 To n

b = a * fA + b * fB

a = a * f

Next i

siEulerB = b

End Function

''''''''''''''''''''''''''''''''''''''' Chapter 7 page 381:

Function siEulerBB _

(k1, k2, oldT1, oldT2, n, crit, oldA, oldb) As Double

' Semi-implicit Euler method for B, modified so that

' it will switch automatically to the steady state

' approximation when k2/k1 becomes larger than a

' given value, here called crit (for criterion).

Dim a As Double, b As Double, step As Double

Dim f As Double, fA As Double, fB As Double

Dim i As Long, m As Long

n = CLng(n)

a = oldA

b = oldb

step = (oldT2 - oldT1) / n

f = (1 - k1 * step / 2) / (1 + k1 * step / 2)

If k2 / k1 > crit Then

For i = 1 To n

a = a * f

Next i

b = k1 * a / k2 ' The steady state approximation

End If

If (k2 / k1 > 1 And k2 / k1 1

Length = Length / 2

Loop

If Length 1 Then

MsgBox "The number of rows must be" _

& Chr(13) & "an integral power of two."

End

End If

' Determine the array length

rMax = Selection.Rows.Count

' Read the input

dataArray = Selection.Value

' Rearrange the input

ReDim Term(1 To 2 * rMax) As Double

For r = 1 To rMax

Term(2 * r - 1) = dataArray(r, 1)

Term(2 * r) = dataArray(r, 2)

Next r

' Call the subroutine

iSign = 1

'Call Four1(Term, 2 * rMax, iSign)

' Rearrange the output

For r = 1 To rMax

dataArray(r, 1) = Term(2 * r - 1)

dataArray(r, 2) = Term(2 * r)

Next r

' Write the output data

Selection.Offset(0, 2).Select

Selection.Value = dataArray

End Sub

''''''''''''''''''''''''''''''''''''''' Chapter 8 page 454:

Sub FourierB(iSign)

Dim cMax As Integer, Length As Integer

Dim iSign As Integer ''''''''''''???????????????

Dim r As Integer, rMax As Integer

Dim dataArray As Variant

' Check the array width

cMax = Selection.Columns.Count

If cMax 2 Then

MsgBox "There must be 2 input columns."

End

End If

' Check the array length

rMax = Selection.Rows.Count

If rMax < 2 Then

MsgBox "There must be at least 2 rows."

End

End If

Length = rMax

Do While length 0> 1

Length = Length / 2

Loop

If Length 1 Then

MsgBox "The number of rows must be" _

& Chr(13) & "an integral power of two."

End

End If

' Determine the array length

rMax = Selection.Rows.Count

' Read the input

dataArray = Selection.Value

' Rearrange the input

ReDim Term(1 To 2 * rMax) As Double

For r = 1 To rMax

Term(2 * r - 1) = dataArray(r, 1)

Term(2 * r) = dataArray(r, 2)

Next r

' Call the subroutine

iSign = 1

'Call Four1(Term, 2 * rMax, iSign)

' Rearrange the output

For r = 1 To rMax

dataArray(r, 1) = Term(2 * r - 1)

dataArray(r, 2) = Term(2 * r)

Next r

' Make sure that the output will

' not overwrite valuable data

Dim outputArray As Variant, z As Double

Dim c As Integer, cMax As Integer

Dim r As Integer, rMax As Integer

Dim n As Integer

n = 0

Selection.Offset(0, 2).Select

OutputArray = Selection.Value

For r = 1 To rMax

For c = 1 To cMax

z = outputArray(r, c)

If IsEmpty(z) Or z = 0 Then

n = n

Else

n = n + 1

End If

Next c

Next r

If n > 0 Then

answer = MsgBox("There are data in the" _

& Chr(13) & "output space. Can they" _

& Chr(13) & "be overwritten?", vbYesNo)

If answer = vbNo Then

Selection.Offset(0, -2).Select

End

End If

End If

' Write the output data

Selection.Offset(0, 2).Select

Selection.Value = dataArray

End Sub

''''''''''''''''''''''''''''''''''''''' Chapter 8 page 457:

Sub MakeGraph()

' Create an embedded graph in the cell grid

Dim ch As ChartObject

Dim cw As Double, rh As Double

cw = Columns(1).Width

rh = Rows(1).Height

Set ch = ActiveSheet.ChartObjects. _

Add(cw * 2, rh * 1, cw * 5, rh * 5)

End Sub

''''''''''''''''''''''''''''''''''''''' Chapter 8 page 458:

Sub MakeGraphA()

' Create an embedded graph in the cell grid

Dim ch As ChartObject

Dim cw As Double, rh As Double

cw = Columns(1).Width

rh = Rows(1).Height

Set ch = ActiveSheet.ChartObjects. _

Add(cw * 3, rh * 4, cw * 8, rh * 16)

' Select the graph type:

ch.Chart.ChartType = xlXYScatter

' Insert data series:

ch.Chart.SeriesCollection.Add Source:= _

ActiveSheet.Range("A7:B27")

End Sub

''''''''''''''''''''''''''''''''''''''' Chapter 8 page 458:

Sub MakeGraphB()

' Create an embedded graph in the cell grid

Dim ch As ChartObject

Dim cw As Double, rh As Double

cw = Columns(1).Width

rh = Rows(1).Height

Set ch = ActiveSheet.ChartObjects. _

Add(cw * 3, rh * 4, cw * 8, rh * 16)

' Select the graph type:

ch.Chart.ChartType = xlXYScatter

' Insert data series:

ch.Chart.SeriesCollection.Add Source:= _

ActiveSheet.Range("A7:B27")

' Insert graph axes:

' (X = "Category", Y = "Value")

With ch.Chart.Axes(xlCategory)

.MinimumScale = 0

.MaximumScale = 100

.MajorUnit = 20

End With

With ch.Chart.Axes(xlValue)

.MinimumScale = 0

.MaximumScale = 25

.MajorUnit = 5

End With

' Define the data range:

ch.Chart.SeriesCollection.Add _

Source:=ActiveSheet.Range("A7:B27"), _

RowCol:=xlColumns, _

SeriesLabels:=True, _

CategoryLabels:=True

' Define the axis labels:

With ch.Chart.Axes(xlCategory)

.MinimumScale = 0

.MaximumScale = 100

.MajorUnit = 20

.HasTitle = True

With .AxisTitle '''''''''???????????????

.Caption = "time / s"

.Font.Size = 12

End With

End With

With ch.Chart.Axes(xlValue)

.MinimumScale = 0

.MaximumScale = 25

.MajorUnit = 5

.HasTitle = True

With .AxisTitle

.Caption = "signal / A"

.Font.Size = 12

.Orientation = xlUpward

End With

End With

' If you don’t want the legend box:

ch.Chart.Legend.Clear

' Specify a graph title

ch.Chart.HasTitle = True

With ch.Chart.ChartTitle

.Caption = "Sample Chart #1"

.Font.Name = "Times Roman"

.Font.Size = 16

.Font.FontStyle = "Italic"

.Font.ColorIndex = 4

End With

With ch.Chart.SeriesCollection(1)

.MarkerBackgroundColorIndex = xlNone

.MarkerForegroundColorIndex = 1

.MarkerStyle = xlCircle

.Smooth = True

.MarkerSize = 7

With .Border

.ColorIndex = 7

.Weight = xlHairline

.LineStyle = xlContinuous

End With

End With

' Do without gridlines:

ch.Chart.Axes(xlValue).HasMajorGridlines = False

ch.Chart.Axes(xlCategory).HasMajorGridlines _

= False

' Define the background color of the graph:

ch.Chart.ChartArea.Interior.ColorIndex = 2

ch.Chart.PlotArea.Interior.ColorIndex = xlNone

' Place tickmarks:

ch.Chart.Axes(xlValue).MajorTickMark _

= xlTickMarkCross

ch.Chart.Axes(xlValue).TickLabelPosition _

= xlTickLabelPositionNextToAxis

' (and do similarly for xlCategory)

' Introduce a second data set:

ch.Chart.SeriesCollection.Add Range("C7:C27")

' Add a secondary vertical scale:

ch.Chart.SeriesCollection(2).AxisGroup = _

xlSecondary

With ch.Chart.Axes(xlValue, xlSecondary)

.HasTitle = True

.AxisTitle.Caption = "log conc"

End With

With ch.Chart.Axes(xlValue, xlSecondary).AxisTitle

.Font.Size = 12

.Orientation = xlUpward

.Top = 60

End With

' Define markers for a second data set:

With ch.Chart.SeriesCollection(2)

.MarkerBackgroundColorIndex = 8

.MarkerForegroundColorIndex = 5

.MarkerStyle = xlTriangle

.Smooth = True

.MarkerSize = 5

End With

' Add a textbox and specify its text

' (note that the numerical values are in points)

With ch.Chart.TextBoxes.Add(164, 116, 96, 50)

.AutoSize = True

.Text = "K1=3"

End With

With ch.Chart.TextBoxes

With .Characters(Start:=1, Length:=4).Font

.Name = "Times New Roman"

.Size = 12

End With

.Characters(Start:=1, Length:=1) _

.Font.FontStyle = "Italic"

.Characters(Start:=2, Length:=1) _

.Font.Subscript = True

End With

End Sub

''''''''''''''''''''''''''''''''''''''' Chapter 8 page 462:

Sub InsertToolbarM()

Dim TBar As CommandBar

Dim Button1, Button2, Button20, Button21

' Delete a possible prior version of M to prevent conflicts

On Error Resume Next

CommandBars("M").Delete

' Create a commandbar

Set TBar = CommandBars.Add

With TBar

.name = "M"

.Position = msoBarTop

.Visible = True

End With

' Create a control button for SolverAid

Set Button1 = CommandBars("M").Controls _

.Add(Type:=msoControlButton)

With Button1

.Caption = "SolverAid "

.Style = msoButtonCaption

.OnAction = "SolverAid"

End With

' Create a popup control for LS

Set Button2 = CommandBars("M").Controls __

.Add(Type:=msoControlPopup)

With Button2

.Caption = " LS "

.TooltipText = "Highlight array" & Chr(13) & _

"before pressing" & Chr(13) & "LS0 or LS1"

.BeginGroup = True

End With

' Create submenus for LS0 and LS1 respectively

Set Button20 = Button2.Controls.Add(Type:=msoControlButton)

With Button20

.Caption = "LS0"

.Style = msoButtonCaption

.OnAction = "LS0"

End With

Set Button21 = Button2.Controls.Add(Type:=msoControlButton)

With Button21

.Caption = "LS1"

.Style = msoButtonCaption

.OnAction = "LS1"

End With

End Sub

''''''''''''''''''''''''''''''''''''''' Chapter 8 page 463:

Sub RemoveToolbarM()

On Error Resume Next

CommandBars("M").Delete

End Sub

''''''''''''''''''''''''''''''''''''''' Chapter 8 page 468:

Function NatLog(a, b)

On Error Resume Next

NatLog = Log(a / b)

If Err.number 0 Then NatLog = "Err# " & _

Err.number & ": " & Err.Description

End Function

''''''''''''''''''''''''''''''''''''''' Chapter 8 page 473:

Sub TestImmediateWindow()

Dim A As Double

Dim B As Double

A = Selection.Value

Debug.Print A

For i = 1 To 5

B = Log(A - i)

Debug.Print B

Next i

End Sub

''''''''''''''''''''''''''''''''''''''' Chapter 11 page 618:

Function cASINH(X) As Double

' Accuracy: minimum pE = 14

Dim n As Integer

Dim Sum As Double, Term As Double

Dim Y As Double, Z As Double

Y = Abs(X)

If Y > 10 ^ 150 Then

Z = Log(2 * Y)

ElseIf Y = 0.2 Then

Z = Log(Y + Sqr(1 + Y ^ 2))

ElseIf Y < 0.2 And Y > 0 Then

Term = -2 * (Y ^ 3) / 3

Sum = Y + Term

n = 2

Do

Term = -Term * 2 * n * (Y ^ 2) / (2 * n + 1)

Sum = Sum + Term

n = n + 1

Loop Until Abs(Term) < 1E-30

Z = Sum * Sqr(1 + Y ^ 2)

ElseIf Y = 0 Then

Z = Log(1)

End If

cASINH = Sgn(X) * Z

End Function

''''''''''''''''''''''''''''''''''''''' Chapter 11 page 619:

Function cErfA(X)

' Based on Abramowitz & Stegun eq.(7.1.6)

Dim n As Integer

Dim Factor, Term, Y

If X < -6 Then

Y = -1

GoTo A

ElseIf X > 6 Then

Y = 1

GoTo A

Else

Term = X * Exp(-X * X)

Y = Term

n = 1

Do

Factor = 2 * X * X / (2 * n + 1)

Term = Term * Factor

Y = Y + Term

n = n + 1

Loop Until Abs(Term / Y) < 1E-50

Y = 2 * Y / Sqr([Pi()])

End If

A:

cErf = Y

End Function

''''''''''''''''''''''''''''''''''''''' Chapter 11 page 623:

Sub TestDecimalAddition()

Dim vA, vB, vSum

vA = "1000000000000.0000000000000234567"

vB = "2000000000000.0000000000000456789"

Debug.Print "a = " & vA

Debug.Print "b = " & vB

vSum = CDec(vA) + CDec(vB)

MsgBox "a = " & vA & vbCr & _

"b = " & vB & vbCr & _

"a + b = " & vSum

Debug.Print "a + b = " & vSum

End Sub

'''''''''''''''''''''''''''''''''''''' Chapter 11 page 628:

Sub Test1a()

Dim a, b, c

Dim MP As Xnumbers

Set MP = New Xnumbers

a = "1234567890.0987654321"

b = MP.xInv(a)

c = MP.xExp(a, 40)

Debug.Print "a = ", a

Debug.Print "1 / a = ", b

Debug.Print "e ^ a = ", c

Set MP = Nothing

End Sub

'''''''''''''''''''''''''''''''''''''' Chapter 11 page 629:

Sub Test1b()

Dim a, b, c

Dim MP As Xnumbers

Set MP = New Xnumbers

With MP

a = "1234567890.0987654321"

b = .xInv(a)

c = .xExp(a, 40)

Debug.Print "a = ", a

Debug.Print "1 / a = ", b

Debug.Print "e ^ a = ", c

End With

Set MP = Nothing

End Sub

'''''''''''''''''''''''''''''''''''''' Chapter 11 page 638:

Sub Test3a()

Dim MP As Xnumbers

Set MP = New Xnumbers

Dim a, b

With MP

a = "1.234567890123456789"

b = .xEval("(a ^3.456)", a)

Debug.Print "a = ", a

Debug.Print "a^3.456 = ", b

End With

Set MP = Nothing

End Sub

'''''''''''''''''''''''''''''''''''''' Chapter 11 page 638:

Sub Test3b()

Dim MP As Xnumbers

Set MP = New Xnumbers

With MP

Dim x(1 To 2, 1 To 2) ' dimension matrix

x(1, 1) = "a": x(1, 2) = .xE ' specify matrix elements

x(2, 1) = "b": x(2, 2) = .xPi

b = .xEval("(a ^ b)", x)

Debug.Print "e = ", x(1, 2)

Debug.Print "Pi = ", x(2, 2)

Debug.Print "e^Pi = ", b

End With

Set MP = Nothing

End Sub

'''''''''''''''''''''''''''''''''''''' Chapter 11 page 639:

Sub Test4()

Dim a, b, c, root1, root2

Dim y(1 To 3, 1 To 2)

Dim MP As Xnumbers

Set MP = New Xnumbers

With MP

a = 1

b = 100000

c = 0.000001

y(1, 1) = "a": y(1, 2) = a

y(2, 1) = "b": y(2, 2) = b

y(3, 1) = "c": y(3, 2) = c

root1 = (-b + Sqr(b ^ 2 - 4 * a * c)) / (2 * a)

root2 = .xEval("((-b + Sqr(b ^ 2 - 4 * a * c)) _

/ (2 * a))", y)

Debug.Print "root1 = ", root1

Debug.Print "root2 = ", root2

End With

Set MP = Nothing

End Sub

'''''''''''''''''''''''''''''''''''''' Chapter 11 page 640:

Function TestSquareRoot(a, b, c)

Dim root As Double

Call SquareRoot(a, b, c)

root = (-b + Sqr(b ^ 2 - 4 * a * c)) / (2 * a)

TestSquareRoot = root

End Function

'''''''''''''''''''''''''''''''''''''' Chapter 11 page 640:

Sub SquareRoot(a, b, c) 'same name as function OK ???????

Dim MP As Xnumbers

Set MP = New Xnumbers

With MP

Dim root, xroot

root = (-b + Sqr(b ^ 2 - 4 * a * c)) / (2 * a)

xroot = .xDiv(.xAdd(.xNeg(b), _

.xSqr(.xSub(.xPow(b, 2), _

.xMult(4, .xMult(a, c))))), .xMult(2, a))

End With

Set MP = Nothing

MsgBox "A: XRoot = " & xroot

Debug.Print a, b, c, root, xroot

End Sub

'''''''''''''''''''''''''''''''''''''' Chapter 11 page 641:

Sub ErrorAccumulation()

Dim MP As Xnumbers

Set MP = New Xnumbers

With MP

.DgtMax = 50

Dim i As Integer, n As Integer, rMax As Integer

rMax = Selection.Rows.Count

NArray = Selection.Value

IArray = Selection.Value

XIArray = Selection.Value

IArray(1, 1) = Log(1.2) ' note the VBA code for

' the natural logarithm

XIArray(1, 1) = .xLn(1.2)

For n = 2 To rMax

IArray(n, 1) = (1 / (n - 1)) - 5 * IArray(n - 1, 1)

XIArray(n, 1) = .xSub(.xDiv(1, (n - 1)), _

.xMult(5, XIArray(n - 1, 1)))

Debug.Print n, IArray(n, 1), XIArray(n, 1)

Next n

End With

Set MP = Nothing

Selection.Offset(0, 1).Select

Selection.Value = IArray

Selection.Offset(0, 1).Select

Selection.Value = XIArray

End Sub

................
................

In order to avoid copyright disputes, this page is only a partial summary.

Google Online Preview   Download