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

这时候还需要把各个工作表合并到一起来形成一个汇总表。这时候比较麻烦也比较容易出错,因为各个表的学号不一定都是一致的、对齐的。因为可能会有人缺考,有人会考号涂错等等。特奉献以下代码,用于合并学生成绩表或者其它类似的表都可以。本代码特点在于不需要使用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

(0)

相关推荐

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

    这时候还需要把各个工作表合并到一起来形成一个汇总表.这时候比较麻烦也比较容易出错,因为各个表的学号不一定都是一致的.对齐的.因为可能会有人缺考,有人会考号涂错等等.特奉献以下代码,用于合并学生成绩表或者其它类似的表都可以.本代码特点在于不需要使用SQL或者Access等大头软件,只需要Excel就可以执行,非常方便,速度也不慢.转载请勿清除广告. 没有合适的局域网管理软件吗?你的网管工具够灵活够高效吗?看看这个network management software. ' ============

  • Java实现获取Excel中的表单控件

    目录 引入jar包 代码示例 Excel中可通过[开发工具]菜单栏下插入表单控件,如文本框.单选按钮.复选框.组合框等等,插入后的控件可执行设置控件格式,如大小.是否锁定.位置.可选文字.数据源区域.单元格链接等.当Excel中已插入上述控件,需要读取时,也可以使用本文中的方法来读取.下面,将通过Java代码示例展示如何来获取Excel文档中的表单控件.以下是读取的方法及步骤,供参考. 引入jar包 按照如下方法来引用Spire.Xls.jar 版本:5.1.0 方法1 将 Free Spire

  • 利用Python第三方库xlwt写入数据到Excel工作表实例代码

    目录 1. 安装 xlwt 库 2. 使用 xlwt 库 2.1 向 Excel 工作表写入单个数据 2.2 向 Excel 工作表写入多个数据 2.3 向 Excel 工作表写入多个数据(进阶) 3. 总结 1. 安装 xlwt 库 Python 写入数据到 Excel 工作簿中可以使用第三方库 xlwt. xlwt 拆分下来看就是 excel 和 write 的简化拼接,意思就是写数据到 Excel. 这个第三方库的 pip 安装命令如下所示: pip install xlwt -i htt

  • C#中如何在Excel工作表创建混合型图表实例

    在进行图表分析的时候,我们可能需要在一张图表呈现两个或多个样式的图表,以便更加清晰.直观地查看不同的数据大小和变化趋势.在这篇文章中,我将分享C#中如何在一张图表中创建不同的图表类型,其中包括如何在同一个图表添加第二个轴. 下面是一个简单的excel工作表,可以看到系列3数据不同于系列1和2,这样我们就可以绘制不同的图表类型和不同的坐标轴来表示变化的数据: 代码片段: 步骤1:新建一个Workbook类的对象并加载要创建图表的excel文件. Workbook workbook = new Wo

  • Python pandas实现excel工作表合并功能详解

    import os,pandas as pd,re #1.获取文件夹下要合并的文件名 dirpath = '文件夹地址' #工作表3特殊处理 需要开始下标和结束下标 begin = 231 end = 238 excel_names = os.listdir(dirpath) #2.获取文件内容 sheet_1_merge = [] sheet_2_merge = [] sheet_3_merge = pd.DataFrame([0,0,0,0,0,0,0]) for excel_name in

  • VBS遍历Excel工作表的实现代码

    核心代码 '****************************************** '拖拽文件,获取文件路径 '****************************************** If wscript.Arguments.count=0 then msgbox "拖拽文件到本图标",0,"提示" End if for a=0 to wscript.Arguments.count-1 strPath=wscript.Arguments(

  • C++实现将数据写入Excel工作表的示例代码

    目录 安装Spire.XLS for C++ 在 C++ 中将文本或数字值写入单元格 完整代码 效果图 在 C++ 中将数组写入指定的单元格范围 完整代码 效果图 直观的界面.出色的计算功能和图表工具,使Excel成为最流行的个人计算机数据处理软件.在独立的数据包含的信息量太少,而过多的数据又难以理清头绪时,制作成表格是数据管理的最有效手段之一.这样不仅可以方便整理数据,还可以方便我们查找和应用数据.后期我们还可以对具有相似表格框架,相同性质的数据进行合并汇总工作.在本文中,您将学习如何使用 S

  • 利用Java实现复制Excel工作表功能

    本文归纳了关于Java如何复制Excel工作表的方法,按不同复制需求,可分为: 1. 复制工作表 1.1 在同一个工作簿内复制工作表 1.2 在不同工作簿间复制工作表 2. 复制指定单元格数据 对于复制方法copy(),这里简单整理了一个表格,其中包含了对数据复制的不同应用需求,可参考使用: 方法 解释 copyFrom(Worksheet worksheet) 复制自源工作表的数据 copy(CellRange sourceRange, CellRange destRange) 复制源数据到目

  • Python调用接口合并Excel表代码实例

    在工作中经常遇到需要打开许多个excel表格,然后合并的需求,合并的同时要求格式必须原汁原味的保留.利用VBA代码可以比较轻松的解决,现在我们来看Python中如何实现. 上代码: from openpyxl import Workbook from win32com.client import Dispatch import os import datetime def copy_excel_file(source_file_list, destination_file): run_app =

  • Java 重命名 Excel 工作表并设置工作表标签颜色的示例代码

    通常在一份Excel文档中可能包含多个内容不同的工作表,而他们的默认名都为Sheet1.Sheet2.Sheet3等.为了方便我们的查找和操作,我们可以将这些工作表重新命名并设置不同的工作表标签颜色.本文就将介绍如何借助Free Spire.XLS for Java来完成这些操作. 产品导入: 1. 下载Free Spire.XLS for Java包并解压缩,然后将lib文件夹下的Spire.Xls.jar包作为依赖项导入到Java应用程序中. 2. 直接通过Maven仓库安装JAR包,按如下

随机推荐