合并Excel工作薄中成绩表的VBA代码,非常适合教育一线的朋友


Posted in Python onApril 09, 2009

这时候还需要把各个工作表合并到一起来形成一个汇总表。这时候比较麻烦也比较容易出错,因为各个表的学号不一定都是一致的、对齐的。因为可能会有人缺考,有人会考号涂错等等。特奉献以下代码,用于合并学生成绩表或者其它类似的表都可以。本代码特点在于不需要使用SQL或者Access等大头软件,只需要Excel就可以执行,非常方便,速度也不慢。转载请勿清除广告。
没有合适的局域网管理软件吗?你的网管工具够灵活够高效吗?看看这个network management software。
' =============================================
' 合并总表时,不参加计算的表格数目
' 因为一般合并的总表放在最后一个工作表,要排除掉这个表。
Const ExcludeSheetCount = 1
' 主函数,因为用到了ADO,必须作如下引用才能运行本代码。
' 工具>引用, 引用ADO(Microsoft ActiveX Data Objects 2.X Library)
' 链接所有sheet到一个总表
' 要合并的表的第一行必须是字段名称,不能是合并单元格
Sub SQL_ADO_EXCEL_JOIN_ALL()
Dim cnn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim i, k, shCount As Integer
Dim SQL, SQL2 As String, cnnStr As String
Dim s1, s2, s3, tmp As String
Dim ws As Worksheet
Const IDIdx = 1
Const ScoreIdx = 3
shCount = ActiveWorkbook.Sheets.Count
' 获取所有考号
' EXCEL 会自动去除重复数据
' SQL = "(select ID from [语文$]) union (select ID from [英语$]) union (select ID from [物理$]) order by ID"
SQL = ""
For i = 1 To shCount - ExcludeSheetCount
s1 = "(SELECT ID FROM [" & Sheets(i).Name & "$])"
If i = 1 Then
SQL = s1
Else
SQL = SQL & " UNION " & s1
End If
Next
'MsgBox SQL
Set ws = ActiveWorkbook.Sheets(shCount)
cnnStr = "provider = microsoft.jet.oledb.4.0;Extended Properties='Excel 8.0;HDR=yes;IMEX=1';data source=" & ThisWorkbook.FullName
cnn.CursorLocation = adUseClient
cnn.ConnectionString = cnnStr
cnn.Open
rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
ws.Activate
ws.Cells.Clear
For i = 1 To rs.Fields.Count
ws.Cells(1, i) = rs.Fields(i - 1).Name
Next
ws.Range("A2").CopyFromRecordset rs
For i = 1 To shCount - ExcludeSheetCount
Sheets(shCount).Cells(1, i + 1) = Sheets(i).Name
Next
'EXCEL 不支持 UPDATE
'SQL = "update [合并$] set 语文 = '1'"
' 相当于内联接
'SQL = "select tt.ID,ta.score as 语文,tb.score as 英语 from [合并$] AS tt, [语文$] as ta, [英语$] as tb "
'SQL = SQL & "where (tt.ID = ta.ID) and (tt.ID = tb.ID)"
' 左联接所有表格
' 通过测试的语句
'SQL = "select tt.ID,ta.score AS 语文,tb.score as 英语 from ([合并$] AS tt left join [语文$] as ta on tt.ID = ta.ID) "
'SQL = SQL & "left join [英语$] as tb on tt.ID = tb.ID"
SQL2 = "([" & Sheets(shCount).Name & "$] AS tt LEFT JOIN [" & Sheets(1).Name & "$] AS t1 ON tt.id=t1.id) "
SQL = "SELECT tt.ID,"
For i = 1 To shCount - ExcludeSheetCount
tmp = "t" & i
SQL = SQL & tmp & ".score AS " & Sheets(i).Name
If i < shCount - ExcludeSheetCount Then SQL = SQL & ", "
If i > 1 Then
SQL2 = "(" & SQL2 & " LEFT JOIN [" & Sheets(i).Name & "$] AS " & tmp & " ON tt.id=" & tmp & ".id)"
End If
Next
s1 = SQL & " FROM " & SQL2 & " ORDER BY tt.ID"
MsgBox s1
rs.Close
rs.Open s1, cnn, adOpenKeyset, adLockOptimistic
' 清除表格
ws.Activate
Cells.Select
Selection.Delete Shift:=xlUp
For i = 1 To rs.Fields.Count
ws.Cells(1, i) = rs.Fields(i - 1).Name
Next
ws.Range("A2").CopyFromRecordset rs
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
Call AddHeader
Call FindBlankCells
Call TableBorderSet
ws.Columns(1).AutoFit
ws.Cells(2, 1).Select
MsgBox "Finished."
End Sub
' 在表格第一行插入行,然后合并单元格,加上说明文字
Sub AddHeader()
Dim ws As Worksheet
Dim s1, s2 As String
shCount = ActiveWorkbook.Sheets.Count
Set ws = Sheets(shCount)
Column = ws.UsedRange.Columns.Count
ws.Rows(1).Insert
s1 = Chr(Asc("A") + Column - 1)
s2 = "A1:" & s1 & "1"
ws.Range(s2).Merge
ws.Rows(1).RowHeight = 100
s1 = "说明" & Chr(13) & Chr(10) & _
"本总表为计算生成,把几个单科的客观题成绩合并在一起,避免手工处理时因考号不对齐而导致错位。" & Chr(13) & Chr(10) & _
"注意:如果某单科成绩表中存在相同考号,则总表中该考号的该科成绩是不准确的。" & Chr(13) & Chr(10) & _
"填涂错误的考号,一般出现在表里顶端或底端"
ws.Cells(1, 1) = s1
ActiveSheet.Rows(1).RowHeight = 80
' 冻结窗格
ActiveSheet.Rows(3).Select
ActiveWindow.FreezePanes = True
ActiveWindow.SmallScroll Down:=0
End Sub
' 设置表格边框
Sub TableBorderSet()
ActiveSheet.UsedRange.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End Sub
' 标记无分数的单元格,方便找出答题卡没有分数的学生
Sub FindBlankCells()
Dim i, j, row, col As Integer
'ActiveSheet.Cells(2, 1).Interior.ColorIndex = 15
row = ActiveSheet.UsedRange.Rows.Count
col = ActiveSheet.UsedRange.Columns.Count
For i = 2 To row
For j = 2 To col
If IsEmpty(ActiveSheet.Cells(i, j).Value) Then
ActiveSheet.Cells(i, j).Interior.ColorIndex = 15
End If
Next
Next
End Sub

Python 相关文章推荐
python通过apply使用元祖和列表调用函数实例
May 26 Python
python修改字典内key对应值的方法
Jul 11 Python
python如何实现excel数据添加到mongodb
Jul 30 Python
Python django使用多进程连接mysql错误的解决方法
Oct 08 Python
Python输出\u编码将其转换成中文的实例
Dec 15 Python
Python 微信之获取好友昵称并制作wordcloud的实例
Feb 21 Python
Django项目基础配置和基本使用过程解析
Nov 25 Python
python爬虫模拟浏览器访问-User-Agent过程解析
Dec 28 Python
Python telnet登陆功能实现代码
Apr 16 Python
python实现Oracle查询分组的方法示例
Apr 30 Python
Sublime Text3最新激活注册码分享适用2020最新版 亲测可用
Nov 12 Python
python实现按日期归档文件
Jan 30 Python
python thread 并发且顺序运行示例
Apr 09 #Python
python 判断一个进程是否存在
Apr 09 #Python
python ElementTree 基本读操作示例
Apr 09 #Python
python 获取et和excel的版本号
Apr 09 #Python
python启动办公软件进程(word、excel、ppt、以及wps的et、wps、wpp)
Apr 09 #Python
python 获取文件列表(或是目录例表)
Mar 25 #Python
Python字符串的encode与decode研究心得乱码问题解决方法
Mar 23 #Python
You might like
动漫定律:眯眯眼都是怪物!这些角色狠话不多~
2020/03/03 日漫
检查php文件中是否含有bom的函数
2012/05/31 PHP
Mysql的Root密码忘记,查看或修改的解决方法(图文介绍)
2013/06/14 PHP
PHP递归遍历指定文件夹内的文件实现方法
2016/11/15 PHP
php防止表单重复提交实例讲解
2019/02/11 PHP
调试php程序的简单步骤
2019/10/04 PHP
Javascript 检测、添加、移除样式(className)函数代码
2009/09/08 Javascript
基于Jquery的仿Windows Aero弹出窗(漂亮的关闭按钮)
2010/09/28 Javascript
jquery实现手机发送验证码的倒计时代码
2014/02/12 Javascript
使用javascript做的一个随机点名程序
2014/02/13 Javascript
javascript生成随机数的方法
2014/05/16 Javascript
Javascript中的delete操作符详细介绍
2014/06/06 Javascript
控制文字内容的显示与隐藏示例
2014/06/11 Javascript
JavaScript编写简单的计算器
2015/11/25 Javascript
AngularJS中$watch和$timeout的使用示例
2016/09/20 Javascript
jquery easyui validatebox remote的使用详解
2016/11/09 Javascript
使用gulp搭建本地服务器并实现模拟ajax
2017/04/05 Javascript
js实现放大镜特效
2017/05/18 Javascript
通过说明与示例了解js五种设计模式
2019/06/17 Javascript
原生javascript自定义input[type=radio]效果示例
2019/08/27 Javascript
React 父子组件通信的实现方法
2019/12/05 Javascript
python中定义结构体的方法
2013/03/04 Python
python实现在每个独立进程中运行一个函数的方法
2015/04/23 Python
Python实现的多线程http压力测试代码
2017/02/08 Python
python实战教程之自动扫雷
2018/07/13 Python
Python爬虫——爬取豆瓣电影Top250代码实例
2019/04/17 Python
wxPython绘图模块wxPyPlot实现数据可视化
2019/11/19 Python
pandas参数设置的实用小技巧
2020/08/23 Python
详解Python中第三方库Faker
2020/09/25 Python
HTML5 拖放功能实现代码
2016/07/14 HTML / CSS
前端实现弹幕效果的方法总结(包含css3和canvas的实现方式)
2018/07/12 HTML / CSS
你所在的项目是如何确定版本号的
2015/12/28 面试题
小学优秀教育工作者事迹材料
2014/05/09 职场文书
大学生实习证明范本
2014/09/19 职场文书
2015年招聘工作总结
2014/12/12 职场文书
《1942》观后感
2015/06/08 职场文书