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.
To fulfill the demand for quickly locating and searching documents.
It is intelligent file search solution for home and business.
Related download
- welcome to bowdoin bowdoin college
- visual basic error codes and messages
- details on excel s rand and fmrg
- macros visual basic for applications vba
- vba macros for solving problems in water chemistry
- comma semicolon and vba strings ntnu
- make your actuarial spreadsheets fly
- texas tech university
- brb arraytools user s manual
Related searches
- welcome to 2nd grade printable
- welcome to relias training course
- welcome to people s bank online
- welcome to city of new haven ct
- welcome to njmcdirect
- welcome to the team letter
- welcome to school songs preschool
- welcome to this place song
- welcome to this place
- welcome to gmail email
- open house welcome to parents
- welcome to patient portal