合并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中解析XML数据的方法
Oct 15 Python
urllib和BeautifulSoup爬取维基百科的词条简单实例
Jan 17 Python
python 列表,数组,矩阵两两转换tolist()的实例
Apr 04 Python
PyQt5每天必学之日历控件QCalendarWidget
Apr 19 Python
解决pycharm的Python console不能调试当前程序的问题
Jan 20 Python
Python元组知识点总结
Feb 18 Python
对python中url参数编码与解码的实例详解
Jul 25 Python
基于Python2、Python3中reload()的不同用法介绍
Aug 12 Python
python实现简单的购物程序代码实例
Mar 03 Python
python实现学生成绩测评系统
Jun 22 Python
python 实现的车牌识别项目
Jan 25 Python
基于Python实现一个春节倒计时脚本
Jan 22 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
PHP小技巧搜集,每个PHPer都来露一手
2007/01/02 PHP
php access 数据连接与读取保存编辑数据的实现代码
2010/05/12 PHP
yii2.0之GridView自定义按钮和链接用法
2014/12/15 PHP
Linux+Nginx+MySQL下配置论坛程序Discuz的基本教程
2015/12/23 PHP
因str_replace导致的注入问题总结
2019/08/08 PHP
jQuery 1.0.2
2006/10/11 Javascript
JQuery对checkbox操作 (循环获取)
2011/05/20 Javascript
event.X和event.clientX的区别分析
2011/10/06 Javascript
分享20个提升网站界面体验的jQuery插件
2014/12/15 Javascript
使用命令对象代替switch语句的写法示例
2015/02/28 Javascript
jquery实现简洁文件上传表单样式
2015/11/02 Javascript
js生成随机数(指定范围)的实例代码
2016/07/10 Javascript
AngularJS 输入验证详解及实例代码
2016/07/28 Javascript
JS访问DOM节点方法详解
2016/11/29 Javascript
Angular使用ng-messages与PHP进行表单数据验证
2016/12/28 Javascript
详解在WebStorm中添加Vue.js单文件组件的高亮及语法支持
2017/10/21 Javascript
Openlayers实现点闪烁扩散效果
2020/09/24 Javascript
windows如何把已安装的nodejs高版本降级为低版本(图文教程)
2020/12/14 NodeJs
Python os模块中的isfile()和isdir()函数均返回false问题解决方法
2015/02/04 Python
Python多线程编程(五):死锁的形成
2015/04/05 Python
编写Python脚本来获取Google搜索结果的示例
2015/05/04 Python
python list排序的两种方法及实例讲解
2017/03/20 Python
Python+OpenCV图片局部区域像素值处理改进版详解
2019/01/23 Python
python+pyqt5编写md5生成器
2019/03/18 Python
Python坐标线性插值应用实现
2019/11/13 Python
vscode写python时的代码错误提醒和自动格式化的方法
2020/05/07 Python
Python之字符串的遍历的4种方式
2020/12/08 Python
《阳光》教学反思
2014/02/23 职场文书
一年级班主任感言
2014/03/08 职场文书
写求职信有哪些注意事项
2014/05/08 职场文书
运动会跳远广播稿5篇
2014/09/17 职场文书
2014年高中生自我评价范文
2014/09/26 职场文书
青年岗位能手事迹材料
2014/12/23 职场文书
对领导班子的意见和建议
2015/06/08 职场文书
蜗居观后感
2015/06/11 职场文书
spring cloud eureka 服务启动失败的原因分析及解决方法
2022/03/17 Java/Android