在EXCEL中用VBA实现全站仪数据导入及其格式化

1、在EXCEL中用VBA实现全站仪数据导入及其格式化蒋 程(湖北省神龙地质工程勘察院, 湖北 武汉 430056 )摘 要 利用VBA实现外部数据导入EXCEL中的工作表并进行格式化,使外部数据导入工作大大简化和高效。关键词 EXCEL应用，数据导入，数据格式化1、前言本单位使用莱卡TCA2003进行隧道收敛变形观测。在实际使用过程中,需要将全站仪的数据导入EXCEL中以进行进一步的分析计算。TCA2003的数据文本带有许多特殊的格式符，若使用EXCEL的“外部数据导入”功能进行导入较为繁琐，并且由于在原始数据中，并未标注小数点，随着基站坐标的设置不同，数据应移动的位数也不尽相同。能否利用EXC

2、EL内置的VBA（Visual Basic for Applications）来实现原始数据的导入并进行格式化呢？笔者尝试并实现了上述设想，使数据导入工作大大简化和高效。2、全站仪数据格式的分析下面我们来分析TCA2003全站仪的数据格式。由全站仪导入(仪器自带的程序)计算机的数据保存于一个名为FILE01.GSI的文件中（GSI-8格式），该文件采用ASCII编码，用写字板打开这个文件，内容如下所示：110001+000G4YGX 81.00+49992815 82.00+49986587 83.06+01003902 110002+000582.1 81.00+49973047 82.00

3、+50016047 83.06+01017070 110003+000582.2 81.00+49974283 82.00+50016418 83.06+01056208通过查阅TPS1000全站仪定位系统操作手册并分析以上的数据可知：每一行记录由四个记录字组成，分别为“11+测点编号”，“81+东坐标值（Y）”，“82+北坐标值（X）”，“83+高程值（Z）”， “11”、“81”、“82”、“83”分别是这四个字段的打头标识符。具体来讲，第一个字段又由两部分组成：第一部分是仪器分配的唯一的、不可能重复的序号，第二部分才是用户输入的“点号”，点号只占8位，不足8位的前面用“0”补齐。这两部分

4、用“+”号连接。第二个字段的打头是“81”标识符，该字段的第六位表明数据的单位，可以的取值为“0”、“6”、“8”，分别代表毫米、1/10毫米、1/100毫米。第三和第四字段的含义与第二字段相似。下面我们的任务是将以上的文本通过VBA导入EXCEL中。3、VBA编程VBA（Visual Basic for Applications）可以看作是内嵌于OFFICE套件中（包括WORD/EXCEL等）的VisualBasic，可以应用于这些软件中的编程,以进一步扩展它们功能。数据导入及格式化的工作可以考虑用一个BUTTON来实现。打开EXCEL，鼠标右键单击工具栏空白处，调出“Visual Basi

5、c”工具条和“控件工具箱”，在EXCEL表单中拉出一个BUTTON，单击这个BUTTON，进入程序编辑界面（如下图1所示）。图1 VBA程序设计界面程序设计基本思路：用户点击“导入”按钮后，程序逐行读入FILE01.GSI文件，对每行数据进行相应的处理，将处理的结果写入EXCEL单元格中，导入完成后，在第一行写上导入的日期，并在其右侧的单元格写入“|”标识，下次导入将以此为起点，因此多次导入不用用户指定导入位置，也不会导致前后覆盖。下面为编写的代码实例：Private Sub cmd1_Click() Dim i As Integer '定义行号 Dim j As Integer &#

6、39;定义列号 Dim bc As String '读入的字符串 Dim ef As String Dim StrTemp As String Dim a As Double Dim k As Integer Dim count As Integer Dim Fn As String '文件名 Dim arrSplit As Variant Variant类型的变量 Dim MySheet As Worksheet 定义工作表单 Set MySheet = Worksheets("数据库") '工作表命名为数据库 j = 1 '寻找数据写入的

7、位置，“ | ”为程序自定义的分隔符 While MySheet.Cells(1, j).Value <> "|" And j < 255 一个表单最多为255列 j = j + 1 Wend If j = 255 Then '没找到“|”标志符或列号等于255 MsgBox "标识符缺失！", vbOKOnly, "Warning!" Exit Sub End If Fn = "C:LEICAFILE01.GSI" '定义即将打开的文件名 Open Fn For Input As

8、 #1 i = 2 '由第二行开始写 Do While Not EOF(1) Input #1, bc '读入一整行文本 arrSplit = Split(bc, " ") '将这一行文本以空格为分隔符，分成若干段。 For k = 0 To UBound(arrSplit) '对每段进行处理 StrTemp = Right(arrSplit(k), 8) ef = Mid(arrSplit(k), 6, 1) '取出字段中的第六位 If k > 0 Then '第1/2/3字段是数据位，进行格式化 Select Cas

9、e ef Case "8" '第六位为8 除以1000000 将数据转换为米 StrTemp = Str(Val(StrTemp) / 1000000) Case "6" '第六位为6 除以10000将数据转换为米 StrTemp = Str(Val(StrTemp) / 10000) Case "0" 第六位为0 除以1000 将数据转换为米 StrTemp = Str(Val(StrTemp) / 1000) End Select Else 将点号字段的前导零去掉。 count = 1 Do While Mid(S

10、trTemp, count, 1) = "0" count = count + 1 Loop count = count - 1 StrTemp = Right(StrTemp, 8 - count) StrTemp = "'" + StrTemp End If MySheet.Cells(i, j + k).Value = StrTemp '格式化好的数据写入单元格 Next k i = i + 1 '行号加1，处理下一行数据 Loop Close MySheet.Cells(1, j + k).Value = "|" '在下次的写入位置上打上“|”标志符。 MySheet.Cells(1, j).Value = "日期=" MySheet.Cells(1, j + 1).Value = Date '第一行写入日期 cmd1.Left = (j + 3) * 42 'BUTTON按钮右移 MsgBox "导入完成！", vbOKOnly, "Warning!" Exit Sub End Sub以上代码调试通过后存盘，退出程序设计界面。第