地铁沉降观测数据分析之巧用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

练习附件及使用方法请联系九天