利用EXCEL VBA批量處理科目匯總表

摘 要：批量憑證裝訂是業務量較大單位財務基礎工作的一個難題。以用友財務軟件U8為例，利用Excel和VBA，通過按照預設的年、月及憑證范圍，批量完成科目匯總表、憑證封面及包角的打印，以期為提高會計基礎工作效率提供一種思路。

關鍵詞：批量處理;科目匯總表;excel;VBA

0 ?引 ?言

隨著IT技術的不斷普及，以關系數據庫為基礎的管理系統在日常工作中得以廣泛應用，憑證裝訂前的科目匯總表、憑證封面及包角填寫成為會計基礎工作一項必要內容，但對憑證業務量大的單位如何對該類工作進行批量處理成為一個難以解決的問題。目前較常見的解決辦法有兩種：一種是通過用友財務軟件進行查詢打印;另一種是專門開發某一管理系統的軟件，根據操作結果來判分。但這兩種方法存在靈活性差、開發不易的問題。

以用友U8的憑證和科目總賬為例，通過取自數據庫中的數據，利用Excel和VBA，按照預定的的年、月、憑證范圍來批量完成這一過程。

1 ?相關工作簿

為完成批量處理過程，設計了sheet1（分冊）、sheet7（科目匯總）兩個工作表，連接分冊也為憑證信息文件，科目匯總為科目匯總表查詢結果，兩表結構如圖1、圖2。

1.1 ?憑證信息表：sheet1（分冊）

如圖1所示，工作表中，B1為賬務年份，B2為賬務月份，B3為自動統計的憑證總冊數;A列A5以下為記賬憑證第幾冊，B列B5以下為憑證起號，C列C5以下為憑證止號。

如圖2所示，工作表的第二行取自分冊工作表，第三行A列為科目編碼;B列為科目名稱，C列為金額合計借方，D列為金額合計貸方;從第四行開始是根據用友財務軟件U8數據庫中的gl_accvouch表的內容統計所得。

批量處理分下3個步驟。

（1）錄入憑證起止號。先在分冊表的B1輸入年份;在B2選擇月份，B2運用數據驗證菜單功能，設置月份序列，提供下拉列表;B3輸入函數“=COUNT（C6：C200）”，自動統計憑證冊數。

然后，自C6開始向下，逐本輸入每本憑證的末張憑證號。

（2）設文本框、命令按鈕。在sheet7（科目匯總）中，插入文本框，存儲第幾冊憑證。插入兩個命令按鈕，一個上顯示"上一頁"，另一個上顯示“下一頁”。

（3）用程序生成科目匯總表。在sheet7（科目匯總）中，按ALT+Fll進入VBE窗口后輸入取數程序代碼，執行后從第四行開始顯示統計結果。

3 ?程序代碼

程序代碼如下：[2]

Sub hzb（）

Dim i

Dim cn As New ADODB.Connection

Dim rs As New ADODB.Recordset

Dim strCn As String， strSQL As String

strCn="Provider=sqloledb;Server=caiwu;Database=UFDATA_011_2019;Uid=sa;Pwd=******;"

'strCn = "Provider=sqloledb;Server=yhcwb;Database=pubs;Uid=sa;Pwd=;"

cn.Open strCn

Rows（"4：65536"）.Select

Selection.ClearContents

ActiveSheet.Cells（1， 1）.Select

Dim cMaxPz As String， cMinPz As String

Dim cPZ As String

Dim iLen As Integer， iPos As Integer

'***取出憑證號***

iPos = InStr（1， ActiveSheet.Cells（2， 2）， "-"）

If iPos = 0 Then ?'******只輸入一個憑證號

cPZ = ActiveSheet.Cells（2， 2）

Else

iLen = Len（Trim（ActiveSheet.Cells（2， 2）））

cMinPz = Left（ActiveSheet.Cells（2， 2）， iPos - 1）

cMaxPz = Right（ActiveSheet.Cells（2， 2）， iLen - iPos）

End If

'**寫入科目代碼和借貸余額**

If iPos = 0 Then

strSQL = "SELECT ?LEFT（ccode，4） AS km，SUM（md） AS jf，SUM（mc） AS df ?FROM GL_accvouch WHERE iyear="

strSQL = strSQL & ActiveSheet.Cells（2， 3） & " AND iperiod=" & ActiveSheet.Cells（2， 4）

strSQL = strSQL & " AND ino_id=" & cPZ

strSQL = strSQL & " GROUP BY LEFT（ccode，4） ORDER BY LEFT（ccode，4） "

Else

strSQL = "SELECT ?LEFT（ccode，4） AS km，SUM（md） AS jf，SUM（mc） AS df ?FROM GL_accvouch WHERE iyear="

strSQL = strSQL & ActiveSheet.Cells（2， 3） & " AND iperiod=" & ActiveSheet.Cells（2， 4）

strSQL = strSQL & " AND ino_id>=" & cMinPz

strSQL = strSQL & " AND ino_id<=" & cMaxPz

strSQL = strSQL & " GROUP BY LEFT（ccode，4） ORDER BY LEFT（ccode，4） "

End If

rs.Open strSQL， cn

i = 4

Do While Not rs.EOF

ActiveSheet.Cells（i， 1） = rs（"km"）

ActiveSheet.Cells（i， 3） = Format（rs（"jf"）， "##，##0.00"）

ActiveSheet.Cells（i， 4） = Format（rs（"df"）， "##，##0.00"）

i = i + 1

rs.MoveNext

Loop

Set rs = Nothing

'***************************

'**寫入科目名稱*

strSQL = "select ccode，ccode_name from code where iyear=" & ActiveSheet.Cells（2， 3） & " and len（ccode）=4 order by ccode"

rs.Open strSQL， cn

Do While Not rs.EOF

For i = 4 To ActiveSheet.UsedRange.Rows.Count

If ActiveSheet.Cells（i， 1） = rs（"ccode"） Then

ActiveSheet.Cells（i， 2） = rs（"ccode_name"）

End If

Next i

rs.MoveNext

Loop

Set rs = Nothing

cn.Close

r = Range（"d650"）.End（xlUp）.Row

Sheet7.Cells（Range（"d650"）.End（xlUp）.Row + 1， 4） = "單位：江蘇省地質調查研究院"

r = Range（"d650"）.End（xlUp）.Row

Cells（r， 4）.HorizontalAlignment = xlRight

End Sub

‘**上一頁**

Private Sub CommandButton1_Click（）

If chTxtBx.Value > 1 Then ? '第幾冊憑證

chTxtBx.Value = chTxtBx.Value - 1

qspzh = Sheet1.Cells（chTxtBx.Value + 5， 2）.Text

zzpzh = Sheet1.Cells（chTxtBx.Value + 5， 3）.Text

Sheet7.Cells（2， 2） = qspzh + "-" + zzpzh

hzb ? ? ? ? ? ? ? ? ? ?'按條件取數

Else

MsgBox "Hi，已經是第一冊了"

End If

End Sub

‘**下一頁**

Private Sub CommandButton2_Click（）

fff = Sheet1.Cells（3， 2）.Value

ddd = chTxtBx.Value

If Val（ddd） < fff Then

chTxtBx.Value = chTxtBx.Value + 1

qspzh = Sheet1.Cells（chTxtBx.Value + 5， 2）.Text

zzpzh = Sheet1.Cells（chTxtBx.Value + 5， 3）.Text

Sheet7.Cells（2， 2） = qspzh + "-" + zzpzh

hzb ? '按條件取數

Else

MsgBox "恭喜，已經是最后一冊了"

End If

End Sub

‘**工作表激活，按第一本憑證參數取數**

Private Sub Worksheet_Activate（）

chTxtBx.Value = 1

qspzh = Sheet1.Cells（chTxtBx.Value + 5， 2）.Text

zzpzh = Sheet1.Cells（chTxtBx.Value + 5， 3）.Text

Sheet7.Cells（2， 2） = qspzh + "-" + zzpzh

hzb ? ? ? '按條件取數

End Sub

4 ?方法的優點與結論

該方法在Excel2003、Excel2010和用友U8環境下測試通過，其具有下列優點。

（1）簡單易用。該辦法主要利用EXCEL的易操作性進行處理，只要用VBA通過SQL語句將數據取到工作簿中，完成分冊表中相關設置，利用上述代碼即可完成科目匯總表輸出功能。

（2）一數三用。分冊參數可以用于封面批量打印和包角批量打印的數據源，只要按照封面和包角的格式略加設計調整。

（3）可移植性強。上述程序代碼不受用友財務系統本身各表結構影響，具有通用性。其他用戶只需要修改取數程序代碼中的服務器地址和數據庫名稱，就可以使用該方法法來批量處理科目匯總表、憑證封面和憑證包角的打印。

參考文獻：

[1] 衣光臻. 分旬科目匯總表在Excel中的模型構建[J]. 商業會計，2014（11）：128-129.

[2] 羅剛軍. Excel VBA程序開發自學寶典[M]. 3版. 北京：電子工業出版社，2014.

作者簡介：

許洪品，男，漢族，江蘇建湖人，1971年5.26，本科，會計師，江蘇省地質調查研究院（江蘇 南京）（210018），研究方向：會計學理論與實踐

課題項目：此文為江蘇省國土資源廳課題“江蘇省地質勘查基金項目資金管理系統開發”項目階段性成果之一。