合并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字符转换
Sep 06 Python
Python中处理字符串之islower()方法的使用简介
May 19 Python
python发送HTTP请求的方法小结
Jul 08 Python
30秒轻松实现TensorFlow物体检测
Mar 14 Python
Pandas 合并多个Dataframe(merge,concat)的方法
Jun 08 Python
Python字典底层实现原理详解
Dec 18 Python
解决torch.autograd.backward中的参数问题
Jan 07 Python
Python 中@property的用法详解
Jan 15 Python
pyCharm 设置调试输出窗口中文显示方式(字符码转换)
Jun 09 Python
在pycharm中使用pipenv创建虚拟环境和安装django的详细教程
Nov 30 Python
python调用jenkinsAPI构建jenkins,并传递参数的示例
Dec 09 Python
Python使用pandas导入xlsx格式的excel文件内容操作代码
Dec 24 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 数组遍历方法大全(foreach,list,each)
2010/06/30 PHP
PHP之APC缓存详细介绍 apc模块安装
2014/01/13 PHP
一张表搞清楚php is_null、empty、isset的区别
2015/07/07 PHP
WordPress中用于检索模版的相关PHP函数使用解析
2015/12/15 PHP
Google Suggest ;-) 基于js的动态下拉菜单
2006/10/11 Javascript
jQuery创建插件的代码分析
2011/04/14 Javascript
jquery创建表格(自动增加表格)代码分享
2013/12/25 Javascript
js document.write()使用介绍
2014/02/21 Javascript
jquery实现相册一下滑动两次的方法
2015/02/09 Javascript
javascript实现行拖动的方法
2015/05/27 Javascript
简单谈谈ES6的六个小特性
2016/11/18 Javascript
详解堆的javascript实现方法
2016/11/29 Javascript
谈谈jQuery之Deferred源码剖析
2016/12/19 Javascript
Vue单文件组件的如何使用方式介绍
2017/07/28 Javascript
探秘vue-rx 2.0(推荐)
2018/09/21 Javascript
webpack4之如何编写loader的方法步骤
2019/06/06 Javascript
javascript设计模式 ? 建造者模式原理与应用实例分析
2020/04/10 Javascript
[01:32]2016国际邀请赛中国区预选赛CDEC战队教练采访
2016/06/26 DOTA
Python读取sqlite数据库文件的方法分析
2017/08/07 Python
python实现redis三种cas事务操作
2017/12/19 Python
Sanic框架配置操作分析
2018/07/17 Python
Python 生成 -1~1 之间的随机数矩阵方法
2018/08/04 Python
Python进阶之@property动态属性的实现
2019/04/01 Python
pytorch之ImageFolder使用详解
2020/01/06 Python
pycharm 实现复制一行的快捷键
2021/01/15 Python
详解html2canvas截图不能截取圆角图片的解决方案
2018/01/30 HTML / CSS
苹果美国官方商城:Apple美国
2016/08/24 全球购物
国际象棋商店:The Chess Store
2018/07/09 全球购物
巴西体育用品商店:Lojão dos Esportes
2018/07/21 全球购物
自我介绍演讲稿
2014/01/15 职场文书
计算机网络及管理学专业求职信
2014/06/05 职场文书
仓库统计员岗位职责
2015/04/14 职场文书
幼儿园老师新年寄语
2015/08/17 职场文书
jdbc使用PreparedStatement批量插入数据的方法
2021/04/27 MySQL
vue ref如何获取子组件属性值
2022/03/31 Vue.js
ECharts transform数据转换和dataZoom在项目中使用
2022/12/24 Javascript