EXCEL-VBA CODE FOR ONE DIMENSIONAL
CONSOLIDATION ANALYSIS
Reference: R.F Craig, Soil Mechanics (Chapter 7), Fourth Edition, Spon Press, London, 1987
To create a program, it simply copies and pastes the code into modules and a command
button. Form related to the program is shown below:
Excel Spreadsheet:
1
Module1 (FDC)
Option Explicit
Public dZ() As Double
Public IP() As Double
Public rsdZ() As Double
Public rsIP() As Double
Public rsTP() As Double
Public m As Integer
Public im As Integer
Sub FDC()
'==================================================================
'FDC v.1.0 Program for One Dimensional Consolidation Analysis, 2004
'by: Gunthar Pangaribuan - Refer to the book:
'An Introduction to Excel for Civil Engineers
'==================================================================
On Error GoTo Check
Dim h As Double, t As Double, cv As Double, Tv As Double, n As Long
Dim FDCCase As Integer, i As Integer, j As Integer
Dim AIP As Double, ATP As Double
im = Cells(4, 2) 'no. of layer
m = 10 * im
h = Cells(3, 2) 'height of layer
t = Cells(5, 5) 'time
cv = Cells(5, 2) 'coef. of consolidation
FDCCase = Cells(3, 5) 'Case of calculation
ReDim dZ(0 To im) As Double, IP(0 To im) As Double
ReDim rsdZ(0 To m) As Double, rsIP(0 To m) As Double, rsTP(0 To m) As Double
Const Beta = 1 / 6
An Introduction to Excel for Civil Engineers 2
For i = 0 To im
dZ(i) = i * h / im
IP(i) = Cells(9 + i, 2)
Next i
're-input dZ and IP to obtain a smooth isochrone curve
n = 1
rsdZ(0) = dZ(0)
rsIP(0) = IP(0)
For i = 0 To im - 1
For j = 1 To 10
rsIP(j) = j * (IP(i + 1) - IP(i)) / 10
rsdZ(j) = j * (dZ(i + 1) - dZ(i)) / 10
rsIP(n) = rsIP(j) + IP(i)
rsdZ(n) = rsdZ(j) + dZ(i)
n = n + 1
Next j
Next i
Dim LastRow
LastRow = [Link]
Range(Cells(9, 1), Cells(LastRow, 4)).ClearContents
If FDCCase = 1 Then
'open layered
Tv = cv * t / (h / 2) ^ 2
n = 1.5 * m ^ 2 * Tv
ReDim u(0 To m + 1, 0 To n + 1) As Double
u(0, 0) = 0
For i = 0 To n
u(0, i + 1) = 0 'first row = 0
u(m, i + 1) = 0 'last row = 0
Next i
An Introduction to Excel for Civil Engineers 3
For i = 1 To m - 1
u(i, 0) = rsIP(i) '> first row to < last row
Next i
'Finite difference approximation:
For j = 0 To n
For i = 1 To m - 1
u(i, j + 1) = u(i, j) + Beta * (u(i - 1, j) + u(i + 1, j) - 2 *
u(i, j))
Next i
Next j
ElseIf FDCCase = 2 Then
'half closed layered
Tv = cv * t / h ^ 2
n = 6 * m ^ 2 * Tv
ReDim u(0 To m + 1, 0 To n + 1) As Double
u(0, 0) = 0
For i = 0 To n
u(0, i + 1) = 0 'first row = 0
Next i
For i = 1 To m
u(i, 0) = rsIP(i)
Next i
'Finite difference approximation:
For j = 0 To n
For i = 1 To m - 1
u(i, j + 1) = u(i, j) + Beta * (u(i - 1, j) + u(i + 1, j) - 2 *
u(i, j))
Next i
'on impermeabel boundary (at m points):
An Introduction to Excel for Civil Engineers 4
i = m: u(i, j + 1) = u(i, j) + Beta * (2 * u(i - 1, j) - 2 * u(i, j))
Next j
Else
GoTo Check
End If
'Result: after t pressure
For i = 1 To m
rsTP(i) = u(i, n + 1)
Next i
'Result
For i = 0 To im
Cells(9 + i, 1).NumberFormat = "0.00"
Cells(9 + i, 1) = dZ(i)
Cells(9 + i, 2).NumberFormat = "0.00"
Cells(9 + i, 2) = IP(i)
Cells(9 + i, 3).NumberFormat = "0.00"
Cells(9 + i, 3) = rsTP(10 * i)
Next i
'Determine area under Isochrone
'using trapezoidal approximation
'in H/m unit
AIP = 0
ATP = 0
For i = 0 To m - 1
AIP = AIP + (rsIP(i) + rsIP(i + 1)) / 2 'area of initial pressure
ATP = ATP + (rsTP(i) + rsTP(i + 1)) / 2 'area of after t pressure
Next i
'Print degree of consolidation, U
Cells(9, 4).NumberFormat = "0%"
Cells(9, 4) = 1 - ATP / AIP
'Produce FDC Chart
Call FDCchart
An Introduction to Excel for Civil Engineers 5
[Link]("A1").Select
Exit Sub
Check: MsgBox "Please check the input data ...", vbOKOnly + vbExclamation, "FDC
Error!"
End Sub
Module2 (FDC)
Sub FDCchart()
On Error Resume Next
Dim Cx1, Cx2, Cy1, Cy2
ReDim mxValbf(0 To im) As Variant, myValbf(0 To im) As Variant
ReDim mxValaf(0 To m + m) As Variant, myValaf(0 To m + m) As Variant
Dim am As Integer
[Link]("Chart 1").Activate
[Link]
[Link]
'creating series lines: initial pressure
am = 1
For i = 0 To im - 1
mxValbf(am) = Array(IP(i), IP(i + 1))
myValbf(am) = Array(dZ(i), dZ(i + 1))
With ActiveChart
.[Link]
.SeriesCollection(am).XValues = mxValbf(am)
.SeriesCollection(am).Values = myValbf(am)
.SeriesCollection(am).Name = "="""""
End With
[Link](am).Select
With Selection
An Introduction to Excel for Civil Engineers 6
.MarkerStyle = xlNone
.Smooth = False
End With
With [Link]
.ColorIndex = 5
.Weight = xlThin
.LineStyle = xlContinuous
End With
am = am + 1
Next i
j = im + m
am = 0
'creating series lines: after t pressure
For i = im + 1 To j
mxValaf(i) = Array(rsTP(am), rsTP(am + 1))
myValaf(i) = Array(rsdZ(am), rsdZ(am + 1))
With ActiveChart
.[Link]
.SeriesCollection(i).XValues = mxValaf(i)
.SeriesCollection(i).Values = myValaf(i)
.SeriesCollection(i).Name = "="""""
End With
[Link](i).Select
With Selection
.MarkerStyle = xlNone
.Smooth = False
End With
With [Link]
.ColorIndex = 7
.Weight = xlMedium
.LineStyle = xlContinuous
End With
am = am + 1
Next i
End Sub
An Introduction to Excel for Civil Engineers 7
Command Button (FDC)
Private Sub CommandButton1_Click()
Call FDC
End Sub
This article is part of the book, "An Introduction to Excel for Civil Engineers", from the
author blog: [Link]
An Introduction to Excel for Civil Engineers 8
