Wednesday, 10 December 2008

Excel to read files then plot

1. File selection: to select which file you want to plot
##############################
Public i As Integer

Sub FileSelect()

' File dialog to select files
'==============================
Dim fd As filedialog
Set fd = Application.filedialog(msoFileDialogFilePicker)

'Declare a variable to contain the path
'of each selected item. Even though the path is aString,
'the variable must be a Variant because For Each...Next
'routines only work with Variants and Objects.
Dim vrtSelectedItem As Variant

ActiveSheet.Cells.Clear

With fd
If .Show = -1 Then
i = 1
For Each vrtSelectedItem In .SelectedItems
Cells(i, 1).Value = vrtSelectedItem
i = i + 1
Next vrtSelectedItem
Else 'The user pressed Cancel.
End If
End With
'Set the object variable to Nothing.
Set fd = Nothing

' Sort the file list as Ascending, otherwise it will be sorted by selecting sequence
'==================================
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A:A")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With


End Sub



2. Main module: to re-arrange the data, format them then plot it.
##############################
Sub Main()


' Initialization
'=================
Dim LastCell As String
Dim wb_1 As Object
Dim ws_3 As Worksheet
Dim ws_plot As Worksheet
Dim FileName As String
Dim R_last As Integer
Set wb_1 = ActiveWorkbook
Set ws_3 = wb_1.Sheets(3)
Set ws_plot = wb_1.Sheets(2)
wb_1.Sheets(1).Activate

' Call the files inserted in worksheet(1), and variable i is public var, declared in module 2.
'=================================
Dim j As Integer
j = 1
R_last = 1
For j = 1 To i - 1
FileName = wb_1.Sheets(1).Cells(j, 1).Value
Call doloop(FileName, R_last, wb_1, ws_3, ws_plot)
Next j


' Delete some useless rows for plotting
'=========================================
Dim k, R_plot As Integer
For k = 2 To R_last
If Left(Cells(k, 1).Value, 1) = ":" Then
Range(Cells(k, 1), Cells(k + 3, 1)).EntireRow.Select
Selection.Delete Shift:=xlUp
R_plot = k - 1
End If
Next k


' Plot the chart
'=================
Dim xyRange, ErrAmount As String
xyRange = "A3:A" & R_plot & "," & "C3:C" & R_plot
ErrAmount = "=" & ws_plot.Name & "!N4:" & "N" & R_plot

ws_plot.Activate
ActiveSheet.Shapes.AddChart.Select
ActiveChart.SetSourceData Source:=Range(xyRange), PlotBy:=xlColumns
ActiveChart.ChartType = xlLine
With ActiveChart.SeriesCollection(1)
.ErrorBar Direction:=xlY, Include:=xlBoth, Type:=xlCustom, Amount:=ErrAmount, MinusValues:=ErrAmount
End With


End Sub

Function doloop(FileName As String, ByRef R_last As Integer, ByRef wb_1 As Object, ByRef ws_3 As Worksheet, ByRef ws_plot As Worksheet)

Dim wb As Object
Dim PosC, R_Str, C_Str As String
Dim R, C As Integer

' Open the text file and copy contents
'=======================================
Workbooks.OpenText FileName:=FileName, Origin:=936, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, Tab:=True

ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Select
LastCell = Selection.Address(RowAbsolute:=True, ReferenceStyle:=xlR1C1)

PosC = InStrRev(LastCell, "C")

R_Str = Right(Left(LastCell, PosC - 1), Len(Left(LastCell, PosC - 1)) - 1)
C_Str = Right(LastCell, Len(LastCell) - PosC)

R = CInt(R_Str) ' total number of rows
C = CInt(C_Str) ' total number of columns

Range(Cells(1, 1), Cells(R, C)).Select
Selection.Copy
Set wb = ActiveSheet.Parent
ws_3.Activate
With ws_3
.Cells(R_last, 1).Activate
.Paste
End With
Application.CutCopyMode = False
wb.Close SaveChanges:=False

R_last = R_last + R

' Move the Standard Deviation part to the right side
'=====================================================
ws_3.Activate
Range(Cells(R_last - R, 1), Cells(R_last - R + R / 2 - 1, C)).Select
Selection.Copy
ws_plot.Activate
With ActiveSheet
.Cells((R_last - R - 1) / 2 + 1, 1).Activate
.Paste
End With

ws_3.Activate
Range(Cells(R_last - R + R / 2, 1), Cells(R_last - 1, C)).Select
Selection.Copy
ws_plot.Activate
With ActiveSheet
.Cells((R_last - R - 1) / 2 + 1, C + 2).Activate
.Paste
End With

End Function

No comments:

My photo
London, United Kingdom
twitter.com/zhengxin

Facebook & Twitter