|
|
年末了，单位要求公司中级干部进行述职公开测评，述职的领导比较多，一般20多人次，另外，还要组织30以上的人进行现场打分，组织的工作量大不用说了，统计工作量也很大，对打完分的表收齐，输入EXCEL表后，还要分别汇总出来，一次评价过程，统计记录应该有600多条，述职后第二天要求把汇总结果上报。想想现在工作真是压力大啊，好在打分表和汇总表格式相同.是上级要求的EXCEL表的格式，本着不变更格式的原则，想用数据透视方法，试过，不太理想。还是想用VBA加SQL方法实现。今天，忙了多半天，终于有了进展，想共享给搞人力资源工作的同仁，也希望同仁有更好的方法来交流。
基本思路是这样的：在文件的布局上，将汇总表和评价人的表放在一个目录下面，也就是有多少人参与了评价，就应该有多少个评价表的工作簿，汇总表只能有一个。这样设计目地是方便统计，如果打分的人多，我们可以组织多人在不同的机器上录入，然后拷入到规定的目录下就行，可以提高录入效率。在测评工作中，评分人的打分表，按规定是不写姓名的，采取匿名方式，在统计过程中，为了保证统计的准确性，便于录入后的核对，一般将打分表写上序号，其对应的EXCEL工作簿也应按编号写名称，如评价表1；评价表2评价表3等等。
这些工作做好后，再考虑编程。编程前首先考虑的是工作表的格式问题，一般情况下，测评工作的表格形式是上级单位规定好的，原则上是不能够变更的，如在本示例中，前六行是不能变动的，而这六行中的单元格中，含有很多的单元格合并的内容。这就给用SQL语句调用带来了困难，我们不能用整个工作表作为数据库来调用，要采用区域的方式作为数据库调用。通常写SQL语句调用数据库名是这样写的，"select * from 文件名$"，这次我们该用，"select * from [sheet1$a6:i17]"，即在文件名后写区域范围。然后，考虑在程序中如何调用数据，我是按照实际统计工作的方法步骤进行的，那就是先将所有的评分表中的数据，成批导入到一个工作表中，然后，再用SQL语句汇总到汇总表中。因此，在汇总表中，增加了一个工作表，我把它称为过渡表。在导入数据时，增加了一列，用来显示打分表的名称，目地是，在导入之后，便于核对打分的数据，区分数据的来源。在编程过程中也方便我们对数据的校验。见下图：
具体编写程序的时候，由于所有文件放在的同一个目录下,必须用一个函数读取所有文件的名称，再让它做个循环体，循环中，遇到名称为“汇总表”时，跳过执行，这样的话，就能逐一读取所有打分表的数据。这里用的函数是dir(),该函数能返回指定目录下的所有文件，可以对文件后缀加限制，如写成：s = Dir(ThisWorkbook.Path & "\*.xls")，就是读取所有EXCEL文件。用do loop做循环，循环结束条件是：Loop Until Len(s) = 0，也就是当所有文件读取完后，再继续读dir（），它的值就是0。
在程序循环过程中，对于每次读取到的文件名，用ADO链接字符串语句打开该文件，再用SQL语句读取里面的数据，将读到的数据复制给过渡表中。读取完毕后，就是所有打分表的全部记录。结果见下图：
有了这样的一组记录，再进行汇总统计就好办多了，再用SQL统计汇总语句，语句中对统计的字段用VAG（）函数，按序号分组统计，就能直接得到想要的结果了。其语句是：select 顺序,姓名,岗位,部门,avg(履职),avg(创新),avg(支持),avg(思路),avg(综合分) from [sheet2$a5:z65536] group by 顺序,姓名,岗位,部门。
好了就讲着多，总结一下这样编程的好处，都是从管理角度考虑的,虽然，这里是用技术说话的，但实际工作中，技术是为管理服务的。一是前面讲过的，录入打分表方便快捷，打分表多，可以分散录入，在汇总考入同一台机器统一目录下，满足上级及时上报的要求。二是对上级的表格不做大的修改，甚至不用修改，将结果直接写入汇总表中，直接打印给领导签字即可。三是有过渡库的存在，可以对工作过程实行有效的监控，出现统计问题时，方便查找，同时，也是给原始资料保留了一个电子版本，符合管理的要求。四是管理人员操作简单，因一般管理人员都会使用EXCEL文件，通用性强，在一个系统单位内部，只要，文件格式一样，不必修改，拿来就可以使用。
下面给出程序代码和示例。
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 顺序,姓名,岗位,部门"
Sheets(1).Range("a6").CopyFromRecordset cn.Execute(s12)
Application.ScreenUpdating = True
End Sub
[ 本帖最后由 weiguoyin868 于 2010-12-7 20:47 编辑 ] |
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2010-11-13 21:52
