合并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实现windows下模拟按键和鼠标点击的方法
Mar 13 Python
python实现DES加密解密方法实例详解
Jun 30 Python
详谈Python中列表list,元祖tuple和numpy中的array区别
Apr 18 Python
python 把文件中的每一行以数组的元素放入数组中的方法
Apr 29 Python
Centos部署django服务nginx+uwsgi的方法
Jan 02 Python
pyqt5中QThread在使用时出现重复emit的实例
Jun 21 Python
django框架CSRF防护原理与用法分析
Jul 22 Python
Python进程池Pool应用实例分析
Nov 27 Python
Python动态强类型解释型语言原理解析
Mar 25 Python
python 进制转换 int、bin、oct、hex的原理
Jan 13 Python
Python爬虫爬取微博热搜保存为 Markdown 文件的源码
Feb 22 Python
基于PyQt5制作一个群发邮件工具
Apr 08 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
mysql5的sql文件导入到mysql4的方法
2008/10/19 PHP
php简单实现批量上传图片的方法
2016/05/09 PHP
PHP实现图片批量打包下载功能
2017/03/01 PHP
Laravel使用PHPQRCODE实现生成带有LOGO的二维码图片功能示例
2017/07/07 PHP
PHP实现SMTP邮件的发送实例
2018/09/27 PHP
javascript知识点收藏
2007/02/22 Javascript
理解JavaScript的caller,callee,call,apply
2009/04/28 Javascript
jQuery一步一步实现跨浏览器的可编辑表格,支持IE、Firefox、Safari、Chrome、Opera
2009/08/28 Javascript
location.href 在IE6中不跳转的解决方法与推荐使用代码
2010/07/08 Javascript
解决jQuery插件tipswindown与hintbox冲突
2010/11/05 Javascript
EasyUI 中 MenuButton 的使用方法
2012/07/14 Javascript
基于javascipt-dom编程 table对象的使用
2013/04/22 Javascript
js中事件的处理与浏览器对象示例介绍
2013/11/29 Javascript
jQuery判断checkbox是否选中的小例子
2013/12/02 Javascript
jQuery 无限级菜单的简单实例
2014/02/21 Javascript
jquery 表格排序、实时搜索表格内容(附图)
2014/05/19 Javascript
TypeScript具有的几个不同特质
2015/04/07 Javascript
angular-cli修改端口号【angular2】
2017/04/19 Javascript
Angular2中如何使用ngx-translate进行国际化
2017/05/21 Javascript
Angular4学习笔记之准备和环境搭建项目
2017/08/01 Javascript
Angular5升级RxJS到5.5.3报错:EmptyError: no elements in sequence的解决方法
2018/04/09 Javascript
Node错误处理笔记之挖坑系列教程
2018/06/05 Javascript
JavaScript实现烟花绽放动画效果
2020/08/04 Javascript
[01:45:05]VGJ.T vs Newbee Supermajor 败者组 BO3 第二场 6.6
2018/06/07 DOTA
Python3实现从指定路径查找文件的方法
2015/05/22 Python
Python os模块学习笔记
2015/06/21 Python
Python多线程应用于自动化测试操作示例
2018/12/06 Python
Python基础之循环语句用法示例【for、while循环】
2019/03/23 Python
Python实现连接MySql数据库及增删改查操作详解
2019/04/16 Python
TensorFlow查看输入节点和输出节点名称方式
2020/01/04 Python
俄罗斯香水和化妆品购物网站:Л’Этуаль
2018/05/10 全球购物
小学教研工作制度
2014/01/15 职场文书
男性健康日的活动方案
2014/08/18 职场文书
大学生党员个人总结
2015/02/13 职场文书
学校禁毒宣传活动总结
2015/05/08 职场文书
2015年幼儿园班主任个人工作总结
2015/10/22 职场文书