利用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），研究方向：会计学理论与实践

课题项目：此文为江苏省国土资源厅课题“江苏省地质勘查基金项目资金管理系统开发”项目阶段性成果之一。