用VBA自动计算水准测量的原始数据.docx

用VBA自动计算水准测量的原始数据2007-02-09 17:51:30|分类： 默认分类 |标签：水准仪原是数据处理计算excevba |字号大中小订阅 Option ExplicitPrivate Sub gaocheng() 数据处理代码 Dim i, K, Pointer Dim I_first As Integer, I_end As Integer I_first = Sheet1.Range(H & 4).Value I_end = Sheet1.Range(H & 5).Value 开始行要为转点下一行,且转点前一行高程数据已经计算好. If Sheet1.Range(D & 1).Value = 1 Then Pointer = MsgBox(数据已经存在,确定覆盖吗?, vbYesNo + vbInformation, 继续?) If Pointer = vbNo Then Exit Sub End If End If K = Sheet1.Range(B & I_first - 1).Value + Sheet1.Range(C & I_first - 1).Value For i = I_first To I_end If Trim(Sheet1.Range(A & i).Value) = ZD Then K = Sheet1.Range(B & i).Value + Sheet1.Range(C & i - 1).Value Else Sheet1.Range(C & i).Value = K - Sheet1.Range(B & i).Value End If Next i MsgBox I LOVE VBA & vbCrLf & CopyRight by ZZL & vbCrLf & , vbInformation, 高程计算完毕 Sheet1.Range(D & 1).Value = 1 End SubPrivate Sub Clear() 清除代码 Dim i For i = Sheet1.Range(H & 4).Value To Sheet1.Range(H & 5).Value Sheet1.Range(C & i).Value = Empty Next i Sheet1.Range(D & 1).Value = Empty End SubSub Macro1() 删除导线点行 Dim i For i = 1 To 445 If Left(Trim(Sheet2.Range(A & i).Value), 1) = D Then Rows(i & : & i).Select Selection.Delete SHIFT:=xlUp End If Next i MsgBox OK End SubSub Macro2() 删除转点行 Dim i For i = 1 To 445 If Sheet2.Range(A & i).Value = ZD Or Trim(Sheet2.Range(A & i).Value) = Then Row