Excel VBA在理正工程地質勘察軟件接口文件生成中的應用

胡新惠

廣東中山地質工程勘察院 廣東 中山 528400

正文：

0 引言

理正工程地質勘察軟件因具有功能強大、性能穩定及通用性強的優點而被廣泛應用于工程勘察內業資料整理工作中。當勘察項目規模大、場地地層情況復雜時，若直接在軟件界面上進行數據錄入，往往工作會十分繁瑣，且容易出錯。Excel軟件數據處理功能強大，界面友好，交互性強，且具有二次開發功能。若直接在Excel軟件上進行勘察資料錄入，然后生成接口文件導入理正勘察軟件中再進行下一步工作，則可以大大提高勘察工作的效率。本文結合工程實例，介紹采用VBA語言在Excel軟件上開發新功能的方法。該新功能可將Excel表格內按特定格式錄入的數據轉換為能被理正勘察軟件識別的文本格式接口文件。

1 理正勘察軟件接口文件的格式

理正勘察軟件接口文件的內容可以包含勘察項目的各種數據，每種數據又由不同的成員組成。理正勘察軟件的幫助文檔對接口文件的格式及數據有詳細的說明（見表1）。這些數據的成員一般可由軟件界面輸入。接口文件中的數據類型有幾十種之多；每個數據的成員又有幾個到幾十個不等。通常，在對一個勘察項目進內業資料整理時，僅需要用到幾種常見的數據，以及數據中幾個常用的成員。

表1 理正勘察軟件接口文件常用數據說明表

接口文件格式說明：

（1）同一行中數據以制表符（Tab鍵）分隔，如果某些字段的值為空直接用Tab鍵跳過，不能用空格鍵代替Tab鍵。每行數據表示一條記錄。

（2）在輸入鉆孔數據時前四個字符必須為#ZK#，輸入土層數據時前四個字符必須為#TC#，輸入取樣數據時前四個字符必須是#QY#。原位試驗和室內試驗按格式對應不同的字符交互相應的數據。

（3）輸入接口數據時，一個鉆孔對應有多個土層數據、多個原位試驗數據、多個取樣數據和室內試驗數據；則每條記錄前都需輸入其相對應的字符。

2 應用實例

理正勘察軟件中關于勘察項目的全部錄入信息量比較龐大。但在實際工作中，我們可能僅僅需要一小部分信息。本文以在Excel 2010軟件上生成理正CAD8.5PB2格式接口文件的范例來闡述生成接口文件的方法。同時，本實例主要對勘察項目中的鉆孔土層信息中常用數據進行處理。

2.1 Excel表格輸入界面的設計

生成理正勘察接口文件之前，需要在Excel表格中按一定格式輸入相應數據，首先需要進行相應的數據錄入界面設計。本文范例設計的Excel表格界面如圖1所示。圖中白色區域為數據錄入區域。

圖1 數據錄入界面

圖1 界面中包含四個按鈕（“清理內容”、“生成標準地層”、“刪除行”及“生成接口文件”），均為ActiveX控件。“清理內容”按鈕的作用是清空數據輸入區域既有的內容，為后續數據輸入準備。“生成標準地層”按鈕的作用是根據第一個鉆孔錄入的地層信息以及總孔數，在界面上為第一個孔之外的每個孔生成與第一個孔一樣的地層信息。“刪除行”按鈕的作用是在數據編輯過程中，刪除光標所在行。“生成接口文件”按鈕的作用是當每個孔的錄入信息都準備好并檢查無誤時，生成能被理正CAD8.5PB2識別并讀入的文本格式文件。

2.2 VBA代碼的編制

VBA代碼的編制一般在VBE環境中進行。可以通過如下方式進入VBE環境：點擊Excel工作薄菜單欄中開發工具選項卡，使選項卡中的設計模式按鈕處于選中狀態。然后雙擊界面中的按鈕，便可進入到VBE（VBA的編程環境）界面中，如圖2所示。每個按鈕均有一段相應代碼與之對應。

圖2 VBE環境

2.2.1 “清理內容”相關代碼

Dim ColNum, RowNum As Long '表格總列數與總行數

Dim AcColNum As Long '表格實際內容占據的列數

Dim AllRange, ClearRange As Range

ColNum = ActiveSheet.Cells.Columns.Count

RowNum = ActiveSheet.Cells.Rows.Count

AcColNum = Cells(3, ColNum).End(xlToLeft).Column

Set ClearRange = Union(Range(Cells(4, 1), Cells(RowNum,ColNum)), Range(Cells(1, AcColNum + 1), Cells(4, ColNum)))

ClearRange.Clear

2.2.2 “生成標準地層”相關代碼

Dim ZKNum, DicenNum, ColNum, RowNum, Tempi, ZKLen,ZKStNum, AcColNum As Long '鉆孔數、地層數、表格列數、表格行數、臨時變量、鉆孔字符長度、鉆孔起始編號、實際列數

Dim ZKStr As String '鉆孔字符

Dim TempRng '臨時區域

ColNum = ActiveSheet.Cells.Columns.Count

RowNum = ActiveSheet.Cells.Rows.Count

DicenNum = ActiveSheet.Cells(RowNum, 2).End(xlUp).Row - 3

If (DicenNum ＞ 0) Then

ZKNum = Application.InputBox(Prompt:="輸入鉆孔個數", Title:="孔數", Type:=1)

If (ZKNum ＞ 1) Then

ZKStr = Left(Cells(4, 1), 2)

ZKLen = Len(Cells(4, 1))

ZKStNum = CLng(Right(Cells(4, 1), ZKLen - 2))

AcColNum = Cells(3, ColNum).End(xlToLeft).Column

For Tempi = 2 To ZKNum

Range(Cells(4, 2), Cells(DicenNum + 3, AcColNum)).Copy Range(Cells((Tempi - 1) * DicenNum + 4, 2), Cells(Tempi * DicenNum +3, AcColNum))

Cells((Tempi - 1) * DicenNum + 4, 1) = ZKStr ﹠ (Tempi + ZKStNum- 1)

If Tempi Mod 2 = 0 Then Range(Cells((Tempi - 1) * DicenNum + 4,1), Cells(Tempi * DicenNum + 3, AcColNum)).Interior.ColorIndex = 33

Next Tempi

End If

End If

2.2.3 “刪除行”相關代碼

Selection.EntireRow.Delete

2.2.4 “生成接口文件”相關代碼

Dim FoldPos, Tempi, DicenNum, RowNum As Long '文件夾字符數、臨時變量、總地層個數、表格總行數

Dim FileName, FolderAddress, DicengFile As String '文件名、文件夾及地層文件

Dim ZKStr, InputZK, DCInfo, InputInfo As String '鉆孔名及錄入數據

FileName = ThisWorkbook.FullName

FoldPos = InStrRev(FileName, "")

FolderAddress = Left(FileName, FoldPos) '文件夾

DicengFile = FolderAddress ﹠ Cells(2, 10) ﹠ "diceng.txt" '地層文件

Open DicengFile For Output As #1

RowNum = ActiveSheet.Cells.Rows.Count

DicenNum = ActiveSheet.Cells(RowNum, 2).End(xlUp).Row - 3

For Tempi = 4 To DicenNum + 3

ZKStr = Replace(Cells(Tempi, 1), " ", "")

If Len(ZKStr) ＞ 0 Then

InputZK = "#ZK#" ﹠ ZKStr

Print #1, InputZK

End If

InputInfo = "#TC#" ﹠ Cells(Tempi, 6) ﹠ Chr(9) ﹠ Cells(Tempi, 5) ﹠String(2, Chr(9)) '輸入信息添加土層名稱及層底深度并到主層編號前

DCInfo = Replace(Cells(Tempi, 2), " ", "") '獲取主層編號數據

If Len(DCInfo) ＞ 0 Then

InputInfo = InputInfo ﹠ DCInfo ﹠ Chr(9) '輸入信息添加主層號并到亞層編號前

Else

InputInfo = InputInfo ﹠ Chr(9)

End If

DCInfo = Replace(Cells(Tempi, 3), " ", "") '獲取亞層編號數據

If Len(DCInfo) ＞ 0 Then

InputInfo = InputInfo ﹠ DCInfo ﹠ Chr(9) '輸入信息添加亞層號并到次亞層編號前

Else

InputInfo = InputInfo ﹠ Chr(9)

End If

DCInfo = Replace(Cells(Tempi, 4), " ", "") '獲取次亞層編號數據

If Len(DCInfo) ＞ 0 Then

InputInfo = InputInfo ﹠ DCInfo ﹠ Chr(9) '輸入信息添加次亞層號并到地質時代編號前

Else

InputInfo = InputInfo ﹠ Chr(9)

End If

DCInfo = Replace(Cells(Tempi, 7), " ", "") '獲取地質時代數據

If Len(DCInfo) ＞ 0 Then

InputInfo = InputInfo ﹠ DCInfo ﹠ Chr(9) '輸入信息添加地質時代并到成因前

Else

InputInfo = InputInfo ﹠ Chr(9)

End If

DCInfo = Replace(Cells(Tempi, 8), " ", "") '獲取成因數據

If Len(DCInfo) ＞ 0 Then

InputInfo = InputInfo ﹠ DCInfo ﹠ String(7, Chr(9)) '輸入信息添加地質時代并到風化程度前

Else

InputInfo = InputInfo ﹠ String(7, Chr(9))

End If

DCInfo = Replace(Cells(Tempi, 9), " ", "") '獲取風化程度數據

If Len(DCInfo) ＞ 0 Then

InputInfo = InputInfo ﹠ DCInfo ﹠ String(7, Chr(9)) '輸入信息添加風化程度并到描述號前

Else

InputInfo = InputInfo ﹠ String(7, Chr(9))

End If

DCInfo = Replace(Cells(Tempi, 10), " ", "") '獲取描述數據

If Len(DCInfo) ＞ 0 Then

InputInfo = InputInfo ﹠ DCInfo '輸入信息添加描述數據

Else

InputInfo = InputInfo ﹠ Chr(9)

End If

Print #1, InputInfo

Next

Close #1

2.3 接口文件的生成

當每個鉆孔的錄入信息都已輸入并檢查無誤時，點擊“生成接口文件”按鈕就可以生成能被理正CAD8.5PB2識別并讀入的文本格式文件，該文件與Excel界面文件保存于同一目錄中。本范例中與圖1界面中所輸入內容相對應的接口文件如圖3所示。

圖3 理正接口文件

3 結語

本文結合工程實例，介紹了利用VBA編程在Excel軟件中生成理正勘察軟件接口文件的方法。為巖土工程勘察數據處理提供了一個新的思路。該方法已經在實際工程中有所應用，大大減輕了工程人員的勞動強度，節省了人力投入，同時滿足了勘察工作內業處理進度的要求，保證了數據處理的準確性，已初步顯現出良好的應用價值。