利用VBA在資源儲量核實中快速計算加權平均品位和礦體品位(厚度)變化系數

莫平衡

（湖南省有色地質勘查局二一七隊，湖南 衡陽 421001）

Microsoft Office軟件的Excel是常用處理數據和統計分析的軟件，在多行業中廣泛使用。在地質工作中常用該軟件的數據儲存與管理、圖表制作、數據分析、函數公式和VBA拓展功能。

本文就利用Excel的VBA功能進行二次開發，智能化計算加權平均品位技術方法進行研究探討，以水口山資源儲量核實項目中的康家灣礦計算應用為例，闡述了快速實現計算加權平均品位和礦體品位(厚度)變化系數計算的過程。

水口山鉛鋅礦是目前湖南省規模較大的有色金屬礦山，礦山實際年產規模50萬噸，礦區位于湖南省常寧市松柏鎮。康家灣鉛鋅金銀礦是上世紀七十年代，運用多種找礦手段探尋到的隱伏鉛鋅金銀盲礦床；區內經歷多期勘查工作，提交多個勘查報告。水口山資源儲量核實項目共收集了康家灣礦11678件樣品資料，需計算2072個加權平均品位，面對如此巨大的計算工作量，如何實現高效智能化準確計算工作成為當務之急。

1 地質簡介

1.1 康家灣礦地質概況

區內賦礦層位為硅化破碎角礫巖層（QB），壺天群（C2+3）、棲霞組（P1q）的碳酸鹽巖層，當沖組及斗嶺組碎屑巖，礦群均產于倒轉背斜軸部及兩翼的硅化破碎帶中。礦體形態多呈似層狀或透鏡狀。為中大型中低溫多期復合疊加充填型鉛鋅金銀礦床。基本分析元素為Pb、Zn、Au、Ag、S。區內探礦工程按勘探線布置，工程分布比較均勻，為便于生產利用，資源量估算方法選用垂直斷面法。

1.2 單工程礦體的圈定原則

區內有兩種類型的礦體，①以鉛鋅為主、伴生硫金銀；②以硫鐵礦為主，伴生鉛鋅金銀。因此在單工程中，凡樣品鉛鋅礦石中鉛、鋅、金、銀，硫鐵礦中的硫品位大于或等于邊界品位者，均視為礦體進行圈定。夾石樣品厚度小于夾石剔除厚度時并入礦體中，并入后單工程平均品位不低于最低工業品位，否則當夾石剔除。

1.3 計算公式

加權平均品位采用長度或面積加權計算，公式如下：

2 VBA代碼設計及加權平均品位快速計算實現

2.1 VBA代碼設計基礎

VBA是Visual Basic宏的語言，是微軟開發應用于桌面程序中執行通用的自動化（OLE）任務的編程語言。主要用于擴展Windows的應用程式功能，特別是Microsoft Office軟件；是應用程式視覺化的Basic腳本。1994年Excel5.0版本就具有VBA宏功能。

本人經過長期摸索結合實際工作，利用VBA宏的功能，編寫了加權平均品位智能計算的代碼，并應用水口山資源儲量核實工作中。

2.2 表格格式和原始數據要求

單工程平均品位計算表格編制樣式見圖1，該表編制過程需注意6點：①用人工在A列“礦體編號”單元格中充填礦體編號代表圈定的礦體。②在同一單工程中出現兩段以上礦體或兩個不同單工程之間、見礦樣品行不足6行，需用空白行隔開。③表頭列數設置需嚴格按圖1樣式編制。④增加或減少元素，需修改VBA代碼；⑤樣品數據有變化，需重新運行VBA代碼。⑥分析結果的原始數據有“微”或者空白值時當零值處理。

圖1 單項工程平均品位計算表樣式

2.3 代碼具體實現過程

在Excel中按Alt+F11鍵進入VBA窗口，將以下代碼輸入模塊：

Sub 單工程平均品位加權計算()

Dim vData As Variant, nRow As Double, nI As Double

Dim vResult As Variant, nStart As Double, nEnd As Double, nFillRow As Double

Dim vProject As Variant

ChDrive Left(ThisWorkbook.Path, 1)

ChDir ThisWorkbook.Path

Application.ScreenUpdating = False

With ActiveSheet

With .UsedRange

nRow = .Rows.Count + .Row - 1

nI = .Columns.Count + .Column - 1

End With

vData = Range("A1:N" & nRow).Value

For nRow = 6 To UBound(vData) + 1

If (vData(nRow + 1 * (nRow = UBound(vData) + 1), 1) = "" Or nRow = UBound(vData) + 1) Then

If IsArray(vResult) Then

With .Range("N" & (nRow - 1) & ":P" & (nRow - 1)).Borders(xlEdgeBottom)

End With

If vResult(1, 2) = 0 Then

For nI = 1 To 6

研究學者認為，目前社會所關注的農產品質量問題就是經濟問題，預警就是指分析、評價和預報以及決策的過程。在進行農產品質量安全預警研究時，就是完成農產品質量安全防范和控制，其中在保證農產品質量安全的基礎之上，依托管理學、經濟學等預警研究法，科學評判農產品質量安全情況，并對農產品安全趨勢進行有效預測，進而做出相對較準確的預報，利用行之有效的應對措施進行驗證[1]。

vResult(nI, 2) = Empty

Next

Else

For nI = 2 To 6

vResult(nI, 2) = vResult(nI, 2) / vResult(1, 2)

Next

End If

nI = nRow - 1 + nStart - 5

.Range("O" & nI & ":P" & nI).Resize(6).Formula = vResult

vResult = Empty

nStart = 0

End If

Else

If nStart = 0 Then

nStart = nRow

End If

If Not IsArray(vResult) Then

vResult = [{"L=","";"Pb=","";"Zn=","";"Au=","";"Ag=","";"S=",""}]

For nI = 1 To 6

vResult(nI, 2) = Empty

Next

End If

For nI = 1 To 6

If nI = 1 Then

vResult(nI, 2) = vResult(nI, 2) + Val(vData(nRow, 7))

Else

vResult(nI, 2) = vResult(nI, 2) + Val(vData(nRow, 7 + nI)) * Val(vData(nRow, 7)) 'I～M列

End If

Next

End If

Next

End With

ExitSub:

Application.AskToUpdateLinks = True

End Sub

點擊“F5鍵”運行代碼，結束后即可得到計算結果，代碼各語句具體的含義，請參閱VBA相關資料，限于篇幅不作詳細介紹。

3 數據透視的靈活運用及礦體品位(厚度)變化系數快速計算的實現

根據《銅、鉛、鋅、銀、鎳、鉬礦地質勘查規范》（DZ／T 0214-2002）規定要求，品位(厚度)變化系數估算公式為，式中：V礦體厚度或品位變化系數；σ單工程厚度或單樣品位統計的均方差；單工程厚度或單樣品位統計的算術平均值。

Excel計算品位(厚度)變化系數主要利用數據透視表功能快速計算出各礦體品位(厚度)的算術平均值和標準偏差（均方差）值。實現思路：①品位變化系數計算基礎數據來源于單工程平均品位計算表（見圖1）。只保留礦體編號和分析結果，其它列全部刪除，不同礦區可根據計算元素進行保留。②點擊“插入”菜單，選擇“數據透視表”功能，選擇“表格和區域”確定。在表右側窗口（圖2），礦體號打勾，選擇Pb加入∑值區域2次，點擊“Pb”選擇平均值項，點擊“Pb2” 選擇標準偏差項，多元素重復操作步驟。③上述操作完成后，即可得到各礦體的品位算術平均值和標準偏差（均方差）值數據，再按變化系數公式計算出結果（見圖3）。厚度變化系數計算方法相同，只是基礎數據采用不同，在此就不作詳細介紹。

圖2 數據透視表字段對話窗口

圖3 變化系數計算結果

4 結論

筆者主編多個大型復雜的資源儲量核實報告及資源儲量估算工作，總結出以下幾點：

（1）加權平均品位計算應用程序可用于資源量計算工作中，有效減少工作量和計算出錯率，節約時間和人工成本。

（2）數據透視的靈活運用可快速計算礦體品位(厚度)變化系數值、品位最大值等；該功能可用于多種數據統計工作。

（3）在實際地質工作中，VBA程序的利用，使我們的計算工作更高效精準，表格更規范化，有效縮減了技術人員編制報告時間。

上述方法，本人經過多次計算驗證結果完全正確，并對VBA代碼編譯無誤檢查和驗證，方法可行，可在資源量/儲量估算中應用。