地鐵沉降觀測數據分析之巧用VBA編程處理

地鐵沉降觀測數據分析之巧用VBA編程處理  

當你觀測了一天累的要死了，回來看着成百上千的測量數據，還要作報表。若是是三五頁報表還好說，若是是2000個點的報表 按照一頁紙張報30個點就得大約70頁的報表。做爲苦逼的測量員，並且更苦逼的是沒有沉降數據處理分析軟件的測量員，並且更更苦逼的有沉降數據處理分析軟件的可是不配套當地監理要求的報表格式的測量員，是否只能人工去作這麼多的日報表呢？想一想還有周報，和月報吧！！！多恐怖啊！做爲一個過來人，謹將本身的體驗和VBA提出來讓你們探討。時間緊湊，沒有多審閱文章。有錯誤的話請提出來改正代碼。附件請聯繫九天。代碼以下

Sub 宏1()
'
' 宏1 宏
'
' 快捷鍵: Ctrl+u
'
Cells.Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = Year(Now()) & "-" & Month(Now()) & "-" & Day(Now())
Cells.Select
ActiveSheet.Paste
[d7:h7] = "=NOW()"
Range("D9:D36").Select
Selection.Copy
Range("C9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'還有計算間隔日期暫時沒作哦！！！！
Range("D61").Select
Range("D61:D88").Select
Application.CutCopyMode = False
Selection.Copy
Range("C61").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D113").Select
Range("D113:D140").Select
Application.CutCopyMode = False
Selection.Copy
Range("C113").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D165").Select
Range("D165:D192").Select
Application.CutCopyMode = False
Selection.Copy

Range("C165").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D217").Select
Range("D217:D244").Select
Application.CutCopyMode = False
Selection.Copy
Range("C217").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D269").Select
Range("D269:D296").Select
Application.CutCopyMode = False
Selection.Copy
Range("C269").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D321").Select
Range("D321:D349").Select
Application.CutCopyMode = False
Selection.Copy
Range("C321").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D373").Select
Range("D373:D399").Select
Application.CutCopyMode = False
Selection.Copy
Range("C373").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D425").Select
Range("D425:D451").Select
Application.CutCopyMode = False
Selection.Copy
Range("C425").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D477").Select
Range("D477:D502").Select
Application.CutCopyMode = False
Selection.Copy
Range("C477").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D529:D556").Select
Application.CutCopyMode = False
Selection.Copy
Range("C529").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D581:D609").Select
Application.CutCopyMode = False
Selection.Copy
Range("C581").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D633").Select
Range("D633:D665").Select
Application.CutCopyMode = False
Selection.Copy
Range("C633").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D7:H7").Select
Application.CutCopyMode = False
Selection.Copy
Range("D7:H7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("P:Q").Select
Application.CutCopyMode = False
Selection.ClearContents

End Sub

練習附件及使用方法請聯繫九天