合并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 字典(Dictionary)操作详解
Mar 11 Python
使用Python3 编写简单信用卡管理程序
Dec 21 Python
详解Python中表达式i += x与i = i + x是否等价
Feb 08 Python
Python 专题二 条件语句和循环语句的基础知识
Mar 19 Python
python中requests爬去网页内容出现乱码问题解决方法介绍
Oct 25 Python
windows下python安装pip图文教程
May 25 Python
python爬虫超时的处理的实例
Dec 19 Python
获取django框架orm query执行的sql语句实现方法分析
Jun 20 Python
python如何实现复制目录到指定目录
Feb 13 Python
Django choices下拉列表绑定实例
Mar 13 Python
Python 解决空列表.append() 输出为None的问题
May 23 Python
Python GUI编程之tkinter 关于 ttkbootstrap 的使用详解
Mar 03 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中date()日期函数有关参数整理
2011/07/19 PHP
ThinkPHP查询语句与关联查询用法实例
2014/11/01 PHP
Thinkphp 框架扩展之Widget扩展实现方法分析
2020/04/23 PHP
jQuery旋转插件—rotate支持(ie/Firefox/SafariOpera/Chrome)
2013/01/16 Javascript
cookie 最近浏览记录(中文escape转码)具体实现
2013/06/08 Javascript
IE6已终止操作问题的2种情况及解决
2014/04/23 Javascript
抛弃Nginx使用nodejs做反向代理服务器
2014/07/17 NodeJs
jQuery打印图片pdf、txt示例代码
2014/07/22 Javascript
js实现对table动态添加、删除和更新的方法
2015/02/10 Javascript
JavaScript中模拟实现jsonp
2015/06/19 Javascript
JavaScript实现广告的关闭与显示效果实例
2015/07/02 Javascript
两款JS脚本判断手机浏览器类型跳转WAP手机网站
2015/10/16 Javascript
超链接怎么正确调用javascript函数
2016/05/23 Javascript
JS图片放大效果简单实现代码
2016/09/08 Javascript
jQuery EasyUI 为Combo,Combobox添加清除值功能的实例
2017/04/13 jQuery
AngularJS中使用ngModal模态框实例
2017/05/27 Javascript
jQuery Pagination分页插件_动力节点Java学院整理
2017/07/17 jQuery
vue-resource拦截器设置头信息的实例
2017/10/27 Javascript
解决微信浏览器缓存站点入口文件(IIS部署Vue项目)
2019/06/17 Javascript
Python挑选文件夹里宽大于300图片的方法
2015/03/05 Python
Python将图片批量从png格式转换至WebP格式
2020/08/22 Python
基于Python socket的端口扫描程序实例代码
2018/02/09 Python
python 通过xml获取测试节点和属性的实例
2018/03/31 Python
python中ASCII码字符与int之间的转换方法
2018/07/09 Python
python批量检查两个对应的txt文件的行数是否一致的实例代码
2020/10/31 Python
用CSS3来实现社交分享按钮
2014/11/11 HTML / CSS
中文系师范生自荐信
2013/10/01 职场文书
晚会主持词开场白
2014/03/17 职场文书
单位委托书怎么写
2014/09/21 职场文书
2014年高中生自我评价范文
2014/09/26 职场文书
2016新年致辞
2015/08/01 职场文书
七年级之家长会发言稿范文
2019/09/04 职场文书
基于Go Int转string几种方式性能测试
2021/04/28 Golang
React列表栏及购物车组件使用详解
2021/06/28 Javascript
Python集合set()使用的方法详解
2022/03/18 Python
Golang Web 框架Iris安装部署
2022/08/14 Python