ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

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

[求助] 多个工作簿汇总问题请求

[复制链接]

TA的精华主题

TA的得分主题

发表于 2010-11-13 07:26 | 显示全部楼层 |阅读模式
年末了,单位要求公司中级干部进行述职公开测评,述职的领导比较多,一般20多人次,另外,还要组织30以上的人进行现场打分,组织的工作量大不用说了,统计工作量也很大,对打完分的表收齐,输入EXCEL表后,还要分别汇总出来,一次评价过程,统计记录应该有600多条,述职后第二天要求把汇总结果上报。打分表和汇总表格式相同.用数据透视方法试过,不太理想。想求用VBA加SQL方法汇总,不想破坏原始表的格式(指表头部分尽量保留)。网上找了些代码,都挺复杂,没看明白,没有太好的方法,求高手相助。

[ 本帖最后由 weiguoyin868 于 2010-12-7 20:49 编辑 ]

打分表

打分表

汇总表

汇总表

TA的精华主题

TA的得分主题

发表于 2010-11-13 08:41 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
有同样经历,敬请高手指教

TA的精华主题

TA的得分主题

 楼主| 发表于 2010-11-13 19:49 | 显示全部楼层

做了一天,基本搞定了

基本思路是这样的:在文件的布局上,将汇总表和评价人的表放在一个目录下面,也就是有多少人参与了评价,就应该有多少个评价表的工作簿,汇总表只能有一个。这样设计目地是方便统计,如果打分的人多,我们可以组织多人在不同的机器上录入,然后拷入到规定的目录下就行,可以提高录入效率。在测评工作中,评分人的打分表,按规定是不写姓名的,采取匿名方式,在统计过程中,为了保证统计的准确性,便于录入后的核对,一般将打分表写上序号,其对应的EXCEL工作簿也应按编号写名称,如评价表1;评价表2评价表3等等。这些工作做好后,再考虑编程。编程前首先考虑的是工作表的格式问题,一般情况下,测评工作的表格形式是上级单位规定好的,原则上是不能够变更的,如在本示例中,前六行是不能变动的,而这六行中的单元格中,含有很多的单元格合并的内容。这就给用SQL语句调用带来了困难,我们不能用整个工作表作为数据库来调用,要采用区域的方式作为数据库调用。通常写SQL语句调用数据库名是这样写的,"select * from 文件名$",这次我们该用,"select * from [sheet1$a6:i17]",即在文件名后写区域范围。然后,考虑在程序中如何调用数据,我是按照实际统计工作的方法步骤进行的,那就是先将所有的评分表中的数据,成批导入到一个工作表中,然后,再用SQL语句汇总到汇总表中。因此,在汇总表中,增加了一个工作表,在导入数据时,增加了一列,用来显示打分表的名称,目地是,在导入之后,便于核对打分的数据,区分数据的来源。在编程过程中也方便我们的数据校验。见下图:

汇总表中的Sheet2表

汇总表中的Sheet2表

编写程序是在汇总表里写VBA代码。
Sub 合并数据()
Dim s$, cn As Object, m&, s1$
m = 6
Application.ScreenUpdating = False
Set xlApp = New Excel.Application
'Set xlBook = xlApp.Workbooks.Open(ThisWorkbook.Path & "\" & "汇总表.xls")
Worksheets("sheet2").Select
Range("a6:z65536") = ""
Set cn = CreateObject("adodb.connection")
s = Dir(ThisWorkbook.Path & "\*.xls")


Do
    If InStr(1, s, "汇总") = 0 Then
    'MsgBox ThisWorkbook.Path & "\" & s
   
    cn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.Path & "\" & s
    s1 = "select '" & s & "',* from [sheet1$a6:i17]"
    Worksheets("sheet2").Select
    Sheets(2).Range("a" & m).CopyFromRecordset cn.Execute(s1)
    m = Range("a65536").End(xlUp).Row + 1
    cn.Close
    End If
    s = Dir
Loop Until Len(s) = 0

    Worksheets("sheet1").Select
    cn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.Path & "\" & "汇总表.xls"
    s12 = "select 顺序,姓名,岗位,部门,avg(履职),avg(创新),avg(支持),avg(思路),avg(综合分) from [sheet2$a5:z65536] group by 顺序,姓名,岗位,部门"
   
    'MsgBox s12
   
    Sheets(1).Range("a6").CopyFromRecordset cn.Execute(s12)


Application.ScreenUpdating = True
End Sub

[ 本帖最后由 weiguoyin868 于 2010-12-7 20:49 编辑 ]
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-12-27 19:54 , Processed in 0.031692 second(s), 9 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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