多个工作簿汇总问题请求

weiguoyin868

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

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

cnwall

有同样经历，敬请高手指教

weiguoyin868

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

汇总表中的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 编辑 ]