图 2
计算表一共分为四个部份：?信息行即第一行，该行在执行计算以前显示本
次计算的名称，执行计算以后显示各测段的闭合差与允许差信息；?列标题即第2、3行；?数据区即列标题以下的空白单元格区域，这里是填写测量数据和显示计算结果的区域；?名称区即最下面的Excel表格的页标签，此页标签名为本次计算的名称，表达了本次测量的地点。
数据区一共分为10列5大栏：?测点里程：单位是公里，直接输入数字的形式而不要输入“K### + ###”的形式，中间点的里程都填好的，这是便于查找指定里程的测点，当要插入特殊点时，可能需要手工输入该点的里程，特别是BM点的里程，必须要填写，如果BM点外的里程为空白，则程序会忽略该BM点。另外，里程不接受负数；?测点说明：这里是相应里程对应的点号，便于阅读和跟测量簿上的数据相对应。在这一列填入“BM”（大写英文），说明此行是一个水准点的读数，任何其它的字符都不能表示此行为水准点的读数；?转点读数（单位：毫米）：包括后视读数与前视读数，一个水准点必须有后视读数或前视读数，除此以外不能在这两列填入数字；?读数（单位：毫米）：包括轨面、路肩、桩顶，是要录入的一栏。轨面读数是主要读数，可以明确表示出线路纵断面的状况，一般来说路肩与桩顶是表示同一个位置，只要完整填写一列即可，之所以增加一个桩顶列，是为了记录特殊情况下在一个纵断面有3个读数的情况；
第6页共18页
⑹标高（单位：米）： 与读数栏相对应包括轨面、路肩、桩顶。这一大栏是程序计算的结果，大部分不需要手工输入，唯一要输入的是BM点（水准点）的标高，BM点的标高应填入最后一列（桩顶）中。
数据区的第一行和最后一行必须为水准点，即在第2列填入BM字符。当输
入水准点（BM）的信息时，必须在该行的第1列和第10列填入数字，即必须告诉程序该水准点的位置与标高。 3、
图 3
程序的命令集成在“抄平计算”菜单中（图3中红色方框中圈中的菜单）。
这个菜单项跟Excel的其它标准菜单一样，用鼠标左健单击它会弹出一个详细的菜单。“抄平计算”菜单随着文件的打开自动增加，一般位于Excel软件菜单栏最后一项，关闭文件以后这个菜单自动删除。
4、各项功能的操作方法如下：
图 4
①抄平计算。选择这个菜单项程序会自动开始计算标高，这个功能一般是在你填写完了测量数据和前后BM点的里程标高以后执行，校核结果显示在Microsoft Excel的状态栏上。
注：可以将“视图(V)”菜单的“状态栏(S)”菜单项打上勾以显示状态栏。 ②校核到下一个BM点。选中一个BM点所在的行，执行此菜单项，程序会自动寻找下一个BM点并校核这两个BM点之间的测量误差。
③校核到最后一个已填好的BM点。选中一个BM点所在的行，执行此菜单项
第7页共18页
之后程序会自动寻找最后一个完整的BM点并校核这两个BM点之间的误差。 ④搜索BM点。这个功能要求你在本文件相同目录下建立一个名为“BM.XLS”的Excel文件，并将水准点的资料填入其中。也可以将原有的水准点复制到同目录下，并重命名为“BM”。选中一个BM点所在的行，执行此菜单项，程序自动寻找BM.XLS中的与BM点里程相近的水准点，并将其里程与标高复制到BM点所在行的第1列与第10列。
⑤插入梭头：选中要在其后插入的行，程序会在当前行的后面增加一行，并在第一列求出前后两个里程的平均值，在第2列填入“梭头”两个字。
⑥插入BM（插入岔尖，插入岔跟）：方法与“插入梭头”一样，“岔尖”表示道岔的基本轨处接头的读数，岔跟表示道岔辙叉后与轨后连接轨接头处的读数，一般岔尖与岔跟处只有轨面读数。
⑦隐藏中间点：执行此功能后程序会将所有转点读数栏为空的行隐藏起来，再次执行此菜单项会显示所有隐藏起来的行。
六、前景展望
1、加强“搜索BM点”的功能，对算法进行优化，使之能更加准确地进行匹配。 2、建立道岔、道口、桥梁的位置表，能根据道岔、道口、桥梁资料在测点中间自动插入特殊点。
3、对程序的价值进行纵深挖掘：①将标高结果导入到纵断面设计软件中去；②改善测量读数的输入方法，可以将电子经纬仪的数据导入到程序中。
4、 将程序移植到手持式计算机（Windows Mobile）上，利用手持式计算机，可
以在测量的同时使用该程序计算。
（附主程序代码）：
第8页共18页
标高快算V2主要程序代码
''代码整理于20**-12-17
Public intPubSort As Integer '测量类别
Public intPubSpace As Integer '测点间隔，米 Public Sub DataWrite() '抄平计算 On Error GoTo ERRORRAISE Dim sngBML As Single Dim sngBMH As Single Dim sngBMNextL As Single Dim sngBMNextH As Single Dim lngF As Long Dim lngHj() As Long
Dim zds As Integer '转点数
Dim intBM As Integer '起算水准点 Dim intBMNext As Integer '止算水准点 Dim intNum As Integer '第几个测段 '一：从BM点到BM点 '获取数值
'一）BM点资料
Cells(1, 1) = \
For intBM = ActiveCell.Row To ActiveSheet.UsedRange.Rows.Count ' If Cells(intBM, 2) = \Next
If intBM >= ActiveSheet.UsedRange.Rows.Count Then MsgBox (\没有找到起算水准点，无法继续计算！\
While intBM < ActiveSheet.UsedRange.Rows.Count
For intBMNext = intBM + 1 To ActiveSheet.UsedRange.Rows.Count If Cells(intBMNext, 2) = \Next
If intBMNext > ActiveSheet.UsedRange.Rows.Count Then MsgBox (\没有找到下一个水准点，计算已经中止！\
If IsEmpty(Cells(intBM, 1)) Or IsEmpty(Cells(intBM, 10)) Or IsEmpty(Cells(intBM, 3)) Then MsgBox (\请输入起算水准点的里程（A列）、标高（J列）和后视读数（C列）！\Rows(intBM).Select: Cells(intBM, 1).Activate: End If IsEmpty(Cells(intBMNext, 1)) Or IsEmpty(Cells(intBMNext, 10)) Or IsEmpty(Cells(intBMNext, 4)) Then MsgBox (\请输入闭合水准点的里程（A列）、标高（J列）和前视读数（D列）！\sngBML = Cells(intBM, 1) sngBMH = Cells(intBM, 10)
sngBMNextL = Cells(intBMNext, 1) sngBMNextH = Cells(intBMNext, 10) lngF = 0: Dim i As Integer For i = intBM To intBMNext
If i <> intBMNext And Not IsEmpty(Cells(i, 3)) Then lngF = lngF + Cells(i, 3) If i <> intBM And Not IsEmpty(Cells(i, 4)) Then lngF = lngF - Cells(i, 4) Next
lngF = (Cells(intBMNext, 10) - Cells(intBM, 10)) * 1000 - lngF
If Abs(lngF) > 30 * (Abs(sngBMNextL - sngBML)) ^ 0.5 Then Excel.Application.StatusBar = sngBML & \段误差过大，无法继续计算！\ End
'二）转点资料 zds = 0
For i = intBM To intBMNext - 1
If Not IsEmpty(Cells(i, 3)) Then zds = zds + 1
第9页共18页
Next i
ReDim lngHj(zds) As Long: Dim index As Integer lngHj(0) = Cells(intBM, 3): index = 1 For i = intBM + 1 To intBMNext - 1
If Not IsEmpty(Cells(i, 3)) Then lngHj(index) = Cells(i, 3) - Cells(i, 4): index = index + 1 Next i
lngHj(0) = sngBMH * 1000 + lngHj(0) + lngF / zds For index = 1 To zds - 1 '计算并修正仪高
lngHj(index) = lngHj(index - 1) + lngHj(index) + lngF / zds Next
Dim x As Integer
x = sngBMNextH * 1000 - (lngHj(zds - 1) - Cells(intBMNext, 4)) For index = zds - 1 To 0 Step -1 '修正多余量 lngHj(index) = lngHj(index) + x
If x = 0 Then Exit For Else If x > 0 Then x = x - 1 Else x = x + 1 Next index = 0
For i = intBM + 1 To intBMNext '填写测点高程
If i <> intBMNext And Not IsEmpty(Cells(i, 3)) Then index = index + 1 If Not IsEmpty(Cells(i, 5)) Then
Cells(i, 8).Value = Format((lngHj(index) - Cells(i, 5)) / 1000, \ End If
If Not IsEmpty(Cells(i, 6)) Then
Cells(i, 9).Value = Format((lngHj(index) - Cells(i, 6)) / 1000, \ End If
If Not IsEmpty(Cells(i, 7)) Then
Cells(i, 10).Value = Format((lngHj(index) - Cells(i, 7)) / 1000, \ End If Next i
Range(\Range(\Range(\Range(\Range(\Cells(1, 1) = Cells(1, 1) & IndexShu(intNum) & \
Cells(1, 1).Characters(Len(Cells(1, 1)) - 2, 3).Font.Subscript = True
Cells(1, 1) = Cells(1, 1) & sngBML & \& sngBMNextL & \& lngF & \≯\& Int(30 * (Abs(sngBMNextL - sngBML)) ^ 0.5) & \
intBM = intBMNext: intNum = intNum + 1 '统计下一段 Wend
With Cells(1, 1).Font
.Name = \ .Size = 12 End With Exit Sub
ERRORRAISE:
MsgBox \程序无法继续运行！\出现错误\End Sub
Public Function IndexShu(ByVal i As Integer) As String Select Case i Case 1
IndexShu = \①\ Case 2
IndexShu = \②\ Case 3
IndexShu = \③\ Case 4
第10页共18页