ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 2708|回复: 1

[分享]VBA工资管理银行上报文件核对程序

[复制链接]

TA的精华主题

TA的得分主题

发表于 2008-5-4 22:22 | 显示全部楼层 |阅读模式
<p>因工资发放的需要,经常要给银行提供上报盘,要求提供一个文本文件,格式:<br/>单位号&nbsp;CHAR(5)<br/>流水号 CHAR(5)<br/>用户名&nbsp;CHAR(8)&nbsp;<br/>帐号 CHAR(19)&nbsp;<br/>时间(CHAR(6)&nbsp;<br/>在上报过程中,经常出现上报错误,如:有空行,位数不对,金额不对等,特编写<br/>了这个核对程序。其实现功能:<br/>&nbsp;&nbsp;&nbsp; 1、查行的位数不对,银行格式行总长52位。<br/>&nbsp;&nbsp;&nbsp;&nbsp;2、查出多余的空行数。<br/>&nbsp;&nbsp;&nbsp; 3、能计算出上报的金额总数。<br/>&nbsp;&nbsp;&nbsp; 包含程序文件和一个模拟的上报文本文件</p><p>主要代码:<br/>Dim filename As String<br/>Dim Result As String<br/>Dim ReadOut As String<br/>Dim fd As FileDialog<br/>Dim Hsum, Changd, I&nbsp; As Integer<br/>Dim Sfje As Double<br/>On Error GoTo esc '错误处理<br/>Set fd = Application.FileDialog(msoFileDialogFilePicker)&nbsp; '定义文件对象<br/>&nbsp;&nbsp;&nbsp; fd.AllowMultiSelect = False<br/>&nbsp;&nbsp;&nbsp; fd.Filters.Clear<br/>&nbsp;&nbsp;&nbsp; 'Filters.Add "所有 WORD 文件", "*.doc", 1<br/>&nbsp;&nbsp;&nbsp; fd.Filters.Add "文本文件", "*.TXT,*.XLS"<br/>&nbsp;&nbsp;&nbsp; fd.InitialFileName = "d:\"<br/>&nbsp;&nbsp;&nbsp; Result = ""<br/>&nbsp;&nbsp;&nbsp; Hsum = 0<br/>&nbsp;&nbsp;&nbsp; Sfje = 0<br/>&nbsp;&nbsp; If fd.Show = -1 Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; filename = fd.SelectedItems(1)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; filenum = FreeFile()<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Open filename For Input As #filenum</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; While Not EOF(filenum)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Input #filenum, Result<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; I = I + 1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Changd = chkGb(Result)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If Changd &lt;&gt; 52 Then&nbsp;<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; MsgBox "第" &amp; I &amp; "行字符串长度有问题," &amp; Changd<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If Result = "" Then&nbsp; '判断空行<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Hsum = Hsum + 1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Else<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Sfje = Sfje + Round(Mid(Right(Result, 15), 1, 9) / 100, 2) '计算金额<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; </p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Wend<br/>End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If Hsum &gt; 0 Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; MsgBox "有" &amp; Hsum &amp; "行无效空行"<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>Cells(2, 2).Value = I<br/>Cells(3, 2).Value = Changd<br/>Cells(4, 2).Value = Hsum<br/>Cells(5, 2).Value = Sfje</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; MsgBox "检查完毕"<br/>esc:</p><p><br/>End Sub<br/><br/> AaenJLaq.rar (11.26 KB, 下载次数: 80) <br/></p>
[此贴子已经被作者于2008-5-5 11:15:05编辑过]
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-6-11 18:15 , Processed in 0.033373 second(s), 11 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表