VBA开发电子表格在GPS网平差后各项成果精度统计中的应用

马永昌
（柳州市勘察测绘研究院）

【摘　要】　本文介绍基于南方GPS4.1软件的平差成果报告，如何利用VBA对电子表格进行开发，根据GPS规范，统计平差成果的各项精度，及时评价成果的质量。
【关键词】　VBA编程 电子表格 GPS精度统计

　　1、引言
　　Excel是目前非常流行的电子表格软件，它具有强大的数据整合汇总分析功能，但当使用者单纯依靠电子表格既有的功能，无法解决他面临的问题（例如：操作繁琐、计算式的表达太复杂、例行性的操作等）时，使用者只好求助自己了。使用Excel的程序开发工具VBA（Visual Basic for Application）来自行设计出解决方案将是使用者首先考虑的解决之道。由于一些软件缺陷，GPS网平差后，成果是否合格，不能立刻判断；必须及时根据GPS规范对成果各项精度进行统计，看是否满足规范要求。如果用电子表格中的公式直接统计，发现有些指标超限，必须根据问题所在重新对GPS网解算，这样将浪费很多时间和精力，有时甚至是一个反复的过程。如果用VBA开发出实用的电子表格程序，立刻统计出平差成果的各项精度，对成果质量作出及时的综合评价，如成果质量存在问题，直接指出超限项，动态的指导GPS网平差，对解算人员来说是一个很好工具。
　　2、GPS控制网平差流程图

　　3、GPS基线解算和网平差处理中的限差规定
　　3.1 采用单基线处理模式时，对于采用同一种数学模型的基线解，其同步时段中任一三边同步环的坐标分量相对闭合差和全长相对闭合差不宜超过如下表的规定：

　　对于采用不同数学模型的基线解，其同步时段中任一三边同步的坐标分量闭合差和全长相对闭合差按照独立独立环闭合差要求检核。同步时段中的多边形同步环，可不重复检核。
　　3.2 无论采用单基线模式或多基线模式解算基线，都应在整个GPS网中选取一组完全的独立基线构成独立环，各独立环的坐标分量闭合差和全长闭合差应符合下式的规定：

　　3.3 复测基线的长度较差，不宜超过下式的规定：

　　3.4 无约束平差中，基线向量的改正数（V△x、V△y、V△z）绝对值应满足下式要求：

　　当超限时，可认为该基线或其附近存在粗差，应采用软件提供的方法或人工方法剔除粗差基线，直至符合上式要求。
　　3.5 约束平差中，基线向量的改正数与剔除粗差后的无约束平差结果的同名基线相应改正数的较差（dV△x、dV△y、dV△z）应符合下式要求：

　　当超差时，可认为作为约束的已知坐标、距离，已知方位与GPS网不兼容，应采用软件提供的或人为的方法剔除某些误差大的约束值，直至符合上式要求。
　　4、南方GPS平差成果文本文件数据格式特点
　　下面为部分南方GPS成果文件数据格式：
　　…… ……
　　重复基线报告
　　基线名　质量　中误差　X　Y　Z　基线长相对误差
　　重复基线　0.004　0.002　0.002　0.003　485.971　8.7ppm
　　31793501-31753501　50.18　0.006　-437.684　-96.766　-187.715　485.971　1/83039
　　…… ……
　　剔除基线后重复基线
　　重复基线　0.004　0.002　0.002　0.003　485.971　8.7ppm
　　31793501-31753501　50.18　0.006　-437.684　-96.766　-187.715　485.971　1/83039
　　31753531-31793531　83.94　0.005　437.688　96.762　187.709　485.972　1/99350
　　重复基线　0.003　0.001　0.002　0.001　2625.644　1.0ppm
　　BMAA3503-31913503　27.31　0.011　-2440.352　-958.172　143.475　2625.642　1/241063
　　31913511-BMAA3511　52.47　0.006　2440.354　958.177　-143.474　2625.646　1/473181
　　基线详细情况
　　…… ……
　　同步环情况：
　　环号　环总长　相对误差　△Xmm　△Ymm　△Zmm　△边长mm　环中的点
　　1　1548.106　2.1Ppm　2.455　0.299　-1.995　3.177　317731763175
　　…… ……
　　2　1827.133　2.4Ppm　-0.376　-4.038　-1.825　4.447　317831763175
　　异步环情况：
　　环号　环总长　相对误差　△Xmm　△Ymm　△Zmm　△边长mm　环中的点
　　4　1642.095　4.9Ppm　-4.213　3.475　5.988　8.105　317931763175
　　…… ……
　　236　7268.303　0.6Ppm　1.344　3.817　2.176　4.595　EAAA3191BMAA
　　WGS84-坐标系下经典自由网平差平差结果
　　三维自由网平差单位权中误差：0.042474（米）
　　基线及其改正
　　基线名　△X　△Y　△Z　△X改正mm　△Y改正mm　△Z改正mm　相对误差
　　31753501--31763501　523.265　-79.028　538.200　-0.644　-0.078　0.1861：224574
　　GXYY3531--AAAA3531　236.790　-392.953　999.621　2.563　4.688　1.7301：177476
　　平差后Wgs84坐标和点位精度
　　…… ……
　　采用网配合法进行转换
　　基线名　△X改正mm　△Y改正mm　相对误差　距离
　　3175--3176　-0.845　1.872　1：218469　754.753
　　GXYY--AAAA　-7.239　16.228　1：134851　1099.857
　　单位权中误差0.005438（米）
　　平差后坐标和点位精度
　　从上面部分数据格式中看出，数据之间有空格间隔，每项成果数都有相应固定格式，例如重复基线数据开始为“剔除基线后重复基线”行，结束数据为“环闭合差报告”行，这些特点为编程创造了条件。
　　5、在编程中如何分离数据及设置电子表格格式
　　5.1 VB中处理字符串常用的几个字符串处理函数
　　Trim(s)　去掉字符串S左右两边的空白字符
　　Len(s)　返回字符串S的长度
　　Left(s,n)　截取字符串S最左边的n个字符
　　Right(s,n)　截取字符串S最右边的n个字符
　　Mid(s,p,n)　在字符串S中，从第p个字符开始，向后截取n个字符
　　Instr([start,] A,B)　返回A字符串在B字符串中最先出现的位置
　　InstrRev([start,] A,B)　返回A字符串在B字符串中出现的位置，从字符串的末尾算起。
　　例如字符串String1="PBC,KL,VQ"，从它里面提取A和B，其中A="PBC"，B="VQ"，程序如下：
　　DimString1$,A$,B$,I As Integer
　　String1="PBC,KL,VQ"
　　I=InStr(String1,",")
　　A=Left(String1,I-1)
　　I=InStrRev(String1,",")
　　B=Right(String1,Len(String1)-I)
　　5.2 用VB设置电子表格格式
　　With对象
　　.Borders(xlEdgeLeft).LineStyle=xlContinuous　设置对象左边线线型为实线
　　.Borders(xlEdgeTop).LineStyle=xlContinuous　设置对象顶部线型为实线
　　.Borders(xlEdgeBottom).LineStyle=xlContinuous　设置对象底部线型为实线
　　.Borders(xlEdgeRight).LineStyle=xlContinuous　设置对象右边线线型为实线
　　.Borders(xlInsideVertical).LineStyle=xlContinuous　设置对象垂直线线型为实线
　　.Borders(xlInsideHorizontal).LineStyle=xlContinuous　设置对象水平线线型为实线
　　.HorizontalAlignment=xlCenter　设置单元格文字水平居中
　　.VerticalAlignment=xlCenter　设置单元格文字垂直居中
　　.Font.FontStyle="宋体"　设置单元格字体
　　.Font.Size=12　设置单元格字体大小
　　.NumberFormat="##0.000"　设置单元格数字格式
　　End With
　　对象.Columns("A:L").AutoFit　设置单元格A至L列自动适应大小
　　这里的对象是指单元格范围，其它一些用法请参阅有关开发Excel的书籍或VBA帮助，在这里只是简单介绍。
　　6、GPS精度统计程序流程图
　　本程序按模块化思路设计，每项精度统计程序为一个独立的子模块，互不影响，每个程序编写思路差不多，重复基线精度统计和同名基线改正数精度统计两个模块编写较复杂些，限于篇幅，只介绍重复基线精度统计模块程序，GPS精度统计程序流程图如下：

　　重复基线精度统计程序流程图如下：

　　程序段如下：
　　Public Sub CFJS()　　'重复基线计算子程序
　　Dim File1$,STR1$,STR2$,N As Integer,I As Integer,J As Integer,IJ As Integer
　　Dim D As Double,a As Double,ab As Double,MinD As Double,MaxD As Double
　　Dim Ds As Double,b As Double,Str3$
　　N0=2
　　a=Val(TextBox1.Text):b=Val(TextBox2.Text)
　　File1=TextBox3.Text
　　Open File1 For Input As #1
　　Str3="重复基线报告"
　　Do While Not EOF (1)
　　Line Input #1,STR1
　　If Trim(STR1)="剔除基线后重复基线" Then
　　Str3="剔除基线后重复基线"
　　Exit Do
　　End If
　　Loop
　　Seek (1),1
　　Do While Not EOF (1)
　　Line Input #1,STR1
　　If Trim(STR1)=Str3 then
　　Line Input #1,STR1
　　Line Input #1,STR1
　　If Str3="重复基线报告" Then
　　Line Input #1,STR1
　　End If
　　N=0
　　IJ=0
　　Do While Not EOF (1)
　　N=N+1
　　N0=N0+1
　　Call DivPartCF(N0,Trim(STR1)) 　　'调用分离数据子程序
　　Line Input #1,STR1
　　STR1=Trim(STR1)
　　I=InStr(STR1," ")
　　If I>0 Then
　　STR2=Left(STR1,I-1)
　　Else
　　STR2=STR1
　　End If
　　If STR2="重复基线" Or STR2="基线详细情况" Then 　　'处理一条重复基线
　　IJ=IJ+1
　　Sheet5.Range("A" & N0-N+1 & ":A" & N0) .Merge
　　Sheet5.Range("D" & N0-N+1 & ":D" & N0) .Merge
　　Sheet5.Range("E" & N0-N+1 & ":E" & N0) .Merge
　　Sheet5.Range("F" & N0-N+1 & ":F" & N0) .Merge
　　Sheet5.Range("G" & N0-N+1 & ":G" & N0) .Merge
　　Sheet5.Range("H" & N0-N+1 & ":H" & N0) .Merge
　　D=0
　　MinD=Val(Sheet5.Cells(N0-N+1,3))
　　MaxD=Val(Sheet5.Cells(N0-N+1,3))
　　For J=1 To N
　　D=D+Val(Sheet5.Cells(N0-N+J,3))
　　If Val(Sheet5.Cells(N0-N+J,3)) > MaxD Then
　　MaxD=Val(Sheet5.Cells(N0-N+J,3))
　　End If
　　Next J
　　D=D/N
　　ab=Sqr(a^2+(b*D/1000)^2)
　　Sheet5.Cells(N0-N+1,1)=IJ
　　Sheet5.Cells(N0-N+1,4)=D
　　Sheet5.Cells(N0-N+1,5)=ab
　　Sheet5.Cells(N0-N+1,6)=(MaxD=MinD)*1000
　　Ds=(MaxD-MinD)*1000
　　Sheet5.Cells(NO-N+1,7)=2*Sqr(2)*ab
　　If Ds <= 2*Sqr(2)*ab Then
　　Sheet5.Cells(N0-N+1,8) = "合格"
　　Else
　　Sheet5.Cells(N0-N+1,8) = "超限"
　　Sheet.Range("A" & N0-N+1 & ":H" & N0).Font.Color=RGB(255,0,0)
　　End If
　　N=0
　　If STR2="基线详细情况" Then Exit Do
　　Line Input #1,STR1
　　End If
　　Loop
　　Exit Do
　　End If
　　Loop
　　Close
　　Sheet5.Cells(N0+2,1)="注：a=" + TextBox1.Text + " " + "b=" + TextBox2.Text + "Ppm d 为平均边长"
　　With Sheet5.Range("A3" & ":H" & N0)
　　.Borders(xlEdgeLeft).LineStyle=xlContinuous
　　.Borders(xlEdgeTop).LineStyle=xlContinuous
　　.Borders(xlEdgeBottom).LineStyle=xlContinuous
　　.Borders(xlEdgeRight).LineStyle=xlContinuous
　　.Borders(xlInsideVertical).LineStyle=xlContinuous
　　.Borders(xlInsideHorizontal).LineStyle=xlContinuous
　　.HorizontalAlignment=xlCenter
　　.Font.Fontstyle="宋体"
　　.Font.Size=12
　　End With
　　With Sheet5.Range("A" & N0+2 & ":H" & N0+2)
　　.Font.FontStyle="宋体"
　　.Font.Size=12
　　End With
　　With Sheet5.Range("C3:" & "E" &N0)
　　.NumberFormat="##0.000"
　　End With
　　With Sheet5.Range("G3:" & "G" &N0)
　　.NumberFormat="##0.000"
　　End With
　　Sheet5.Range("A2" & ":H" & N0).Columns("A:H").AutoFit 　　'将单元格范围调至最适中行高和列宽
　　End Sub
　　Pulic Sub DivPartCF(N0 As Integer,STR1 As String) 　　'重复基线分离数据子程序
　　Dim Ds As Double,NumSTR$(8),I As Integer,NJ As Integer
　　For I=1 To 8
　　NJ=InStr(STR1,"")
　　If NJ>0 Then
　　NumSTR(1)=Left(STR1,NJ-1)
　　STR1=Trim(Right(STR1,Len(STR1)-NJ)
　　Else
　　NumSTR(I)=STR1
　　End If
　　Next I
　　Sheet5.Cells(N0,2)=NumSTR(1)
　　Sheet5.Cells(N0,3)=NumSTR(7)
　　End Sub
　　7、结束语
　　VBA作为开发电子表格的强大工具，它简单易学，对有一定编程基础的人，很快就能够应用它。电子表格具有很强报表处理和打印功能，如果好好地利用它，很容易设计出优美的报表，解决我们工作中遇到的实际问题。作者通过设计GPS平差成果精度统计程序，把那些复杂统计问题，变得非常容易了，对此深感不疑。

参 考 文 献
[1] 全球定位系统城市测量技术规程.CJJ73-97.北京：《中国建筑工业出版社》.1997
[2] 李文瑞著，赵颖恪、范莹等改编.《VBA/Excel 2000让我把工作变轻松了》.人民邮电出版社.2000