|
引用：https://www./ArticleVBnet/vb3453.html 以前做了vb6.0操作excel的实例，后来转换成c#操作excel，再后来又转换成vb.net操作excel，通过比较，同样是运行在。.net环境下，但是vb.net明显要比c#快很多。 我做的是成绩统计软件，一个窗体。俩控件：菜单和打开文件对话框。    子程序目录： 1、算成绩（m）。2、成绩册（m）。3、横排（h，l）。4、纵排（h，l）。5、单科统计表（m，n）。6、算分栏（h）。 7、单科汇总（i）。8、填数据（m）。9、清数据（m）。 10、上报表（m）。11、工作表命名（）。12、过成绩（m）。 13、打开（）。14、建空表（m）。15、无英语学校汇总（m）。 16、有英语学校汇总（m）。17、计算器。 ━━━━━━━━━━━━━━━━━━━━━━━━━ 编码主要分为主程序和子程序两个模块。 注意：要添加引用excel。 Imports System.IO Public Class 统计成绩 Public 调用 = New 子程序() Public 电子表格 As Excel.Application '定义变量 Public 工作簿 As Excel.Workbook Public 工作表 As Excel.Worksheet Public 单元格 As Excel.Range Private Sub 一年级ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 一年级ToolStripMenuItem.Click Call 调用.建空表(10) Call 调用.工作表命名(1) Call 调用.成绩册(1) End Sub Private Sub 二年级ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 二年级ToolStripMenuItem.Click Call 调用.建空表(10) Call 调用.工作表命名(2) Call 调用.成绩册(2) End Sub Private Sub 三年级ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 三年级ToolStripMenuItem.Click Call 调用.建空表(8) Call 调用.工作表命名(3) Call 调用.成绩册(3) End Sub Private Sub 四年级ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 四年级ToolStripMenuItem.Click Call 调用.建空表(8) Call 调用.工作表命名(3) Call 调用.成绩册(3) End Sub Private Sub 五年级ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 五年级ToolStripMenuItem.Click Call 调用.建空表(8) Call 调用.工作表命名(3) Call 调用.成绩册(3) End Sub Private Sub 六年级ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 六年级ToolStripMenuItem.Click Call 调用.建空表(8) Call 调用.工作表命名(3) Call 调用.成绩册(3) End Sub Private Sub 学校总评ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 学校总评ToolStripMenuItem.Click Call 调用.建空表(1) Dim nj(6) As String nj(1) = "一年级" : nj(2) = "二年级" : nj(3) = "三年级" : nj(4) = "四年级" : nj(5) = "五年级" : nj(6) = "六年级" '建立积分表 Dim 工作表 = 调用.工作簿.Worksheets("sheet1") 工作表.Name = "学校积分" 工作表.Range(工作表.Cells(1, 1), 工作表.Cells(1, 9)).MergeCells = True 工作表.Cells(1, 1) = "学校积分统计表" 工作表.Cells(2, 1) = "学校" 工作表.Cells(3, 1) = "南村小学" 工作表.Cells(4, 1) = "东风小学" 工作表.Cells(5, 1) = "兴中小学" 工作表.Cells(6, 1) = "尧场小学" For i = 1 To 6 工作表.Cells(2, i + 1) = nj(i) + "积分" Next 工作表.Cells(2, 8) = "均积分" 工作表.Cells(2, 9) = "名次" 工作表.Range(工作表.Cells(2, 1), 工作表.Cells(6, 9)).Borders.LineStyle = 1 '表格加线 Dim h = 6, l = 9 单元格 = 工作表.Range(工作表.Cells(1, 1), 工作表.Cells(h, l)) '设置行高和列宽 单元格.HorizontalAlignment = Excel.Constants.xlCenter '水平居中 单元格.RowHeight = 工作表.Application.CentimetersToPoints(Math.Round((21.3 - 3 * 2) / h, 2)) 工作表.Range(工作表.Cells(2, 1), 工作表.Cells(11, 1)).ColumnWidth = 16.13 工作表.Range(工作表.Cells(2, 2), 工作表.Cells(h, l)).ColumnWidth = Math.Round((29.7 - 3.69 - 1.9 * 2) / (l - 1) * 4.374, 2) 工作表.PageSetup.Orientation = Excel.XlPageOrientation.xlLandscape '横向打印 End Sub Private Sub 上报ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 上报ToolStripMenuItem.Click Call 调用.建空表(2) 调用.上报表() End Sub Private Sub 全部表册ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 全部表册ToolStripMenuItem.Click Directory.CreateDirectory("C:\Documents and Settings\Administrator\桌面\成绩统计") '建立文件夹 调用.建空表(10) '一年级 Call 调用.工作表命名(1) : Call 调用.成绩册(1) 调用.工作簿.SaveAs("C:\Documents and Settings\Administrator\桌面\成绩统计\一年级.xls") 调用.工作簿.Close() 调用.电子表格.quit() 调用.建空表(10) '二年级 Call 调用.工作表命名(2) : Call 调用.成绩册(2) 调用.工作簿.SaveAs("C:\Documents and Settings\Administrator\桌面\成绩统计\二年级.xls") 调用.工作簿.Close() 调用.电子表格.quit() 调用.建空表(8) '三年级 Call 调用.工作表命名(3) : Call 调用.成绩册(3) 调用.工作簿.SaveAs("C:\Documents and Settings\Administrator\桌面\成绩统计\三年级.xls") 调用.工作簿.Close() 调用.电子表格.quit() 调用.建空表(8) '四年级 Call 调用.工作表命名(4) : Call 调用.成绩册(4) 调用.工作簿.SaveAs("C:\Documents and Settings\Administrator\桌面\成绩统计\四年级.xls") 调用.工作簿.Close() 调用.电子表格.quit() 调用.建空表(8) '五年级 Call 调用.工作表命名(5) : Call 调用.成绩册(5) 调用.工作簿.SaveAs("C:\Documents and Settings\Administrator\桌面\成绩统计\五年级.xls") 调用.工作簿.Close() 调用.电子表格.quit() 调用.建空表(8) '六年级 Call 调用.工作表命名(6) : Call 调用.成绩册(6) 调用.工作簿.SaveAs("C:\Documents and Settings\Administrator\桌面\成绩统计\六年级.xls") 调用.工作簿.Close() 调用.电子表格.quit() Call 调用.建空表(1) '学校总评 Dim nj(6) As String nj(1) = "一年级" : nj(2) = "二年级" : nj(3) = "三年级" : nj(4) = "四年级" : nj(5) = "五年级" : nj(6) = "六年级" '建立积分表 Dim 工作表 = 调用.工作簿.Worksheets("sheet1") 工作表.Name = "学校积分" 工作表.Range(工作表.Cells(1, 1), 工作表.Cells(1, 9)).MergeCells = True 工作表.Cells(1, 1) = "学校积分统计表" 工作表.Cells(2, 1) = "学校" 工作表.Cells(3, 1) = "南村小学" 工作表.Cells(4, 1) = "东风小学" 工作表.Cells(5, 1) = "兴中小学" 工作表.Cells(6, 1) = "尧场小学" For i = 1 To 6 工作表.Cells(2, i + 1) = nj(i) + "积分" Next 工作表.Cells(2, 8) = "均积分" 工作表.Cells(2, 9) = "名次" 工作表.Range(工作表.Cells(2, 1), 工作表.Cells(6, 9)).Borders.LineStyle = 1 '表格加线 Dim h = 6, l = 9 单元格 = 工作表.Range(工作表.Cells(1, 1), 工作表.Cells(h, l)) '设置行高和列宽 单元格.HorizontalAlignment = Excel.Constants.xlCenter '水平居中 单元格.RowHeight = 工作表.Application.CentimetersToPoints(Math.Round((21.3 - 3 * 2) / h, 2)) 工作表.Range(工作表.Cells(2, 1), 工作表.Cells(11, 1)).ColumnWidth = 16.13 工作表.Range(工作表.Cells(2, 2), 工作表.Cells(h, l)).ColumnWidth = Math.Round((29.7 - 3.69 - 1.9 * 2) / (l - 1) * 4.374, 2) 工作表.PageSetup.Orientation = Excel.XlPageOrientation.xlLandscape '横向打印 调用.工作簿.SaveAs("C:\Documents and Settings\Administrator\桌面\成绩统计\学校总评.xls") 调用.工作簿.Close() 调用.电子表格.quit() Call 调用.建空表(2) 调用.上报表() 调用.工作簿.SaveAs("C:\Documents and Settings\Administrator\桌面\成绩统计\上报.xls") 调用.工作簿.Close() 调用.电子表格.quit() MessageBox.Show("生成的'成绩统计’文件夹已存在桌面。") End Sub Private Sub 计算器ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 计算器ToolStripMenuItem.Click System.Diagnostics.Process.Start("calc.exe") End Sub Private Sub 一年级ToolStripMenuItem1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 一年级ToolStripMenuItem1.Click 调用.打开() 调用.填数据(1) End Sub Private Sub 二年级ToolStripMenuItem1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 二年级ToolStripMenuItem1.Click 调用.打开() 调用.填数据(2) End Sub Private Sub 三年级ToolStripMenuItem1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 三年级ToolStripMenuItem1.Click 调用.打开() 调用.填数据(3) End Sub Private Sub 四年级ToolStripMenuItem1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 四年级ToolStripMenuItem1.Click 调用.打开() 调用.填数据(4) End Sub Private Sub 五年级ToolStripMenuItem1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 五年级ToolStripMenuItem1.Click 调用.打开() 调用.填数据(5) End Sub Private Sub 六年级ToolStripMenuItem1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 六年级ToolStripMenuItem1.Click 调用.打开() 调用.填数据(6) End Sub Private Sub 一年级ToolStripMenuItem2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 一年级ToolStripMenuItem2.Click 调用.打开() 调用.清数据(1) End Sub Private Sub 二年级ToolStripMenuItem2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 二年级ToolStripMenuItem2.Click 调用.打开() 调用.清数据(2) End Sub Private Sub 三年级ToolStripMenuItem2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 三年级ToolStripMenuItem2.Click 调用.打开() 调用.清数据(3) End Sub Private Sub 四年级ToolStripMenuItem2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 四年级ToolStripMenuItem2.Click 调用.打开() 调用.清数据(4) End Sub Private Sub 五年级ToolStripMenuItem2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 五年级ToolStripMenuItem2.Click 调用.打开() 调用.清数据(5) End Sub Private Sub 六年级ToolStripMenuItem2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 六年级ToolStripMenuItem2.Click 调用.打开() 调用.清数据(6) End Sub Private Sub 全部填ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 全部填ToolStripMenuItem.Click Dim 电子表格 As New Excel.Application() '一年级 电子表格.Visible = True 调用.工作簿 = 电子表格.Workbooks.Open("C:\Documents and Settings\Administrator\桌面\成绩统计\一年级.xls") 调用.填数据(1) 调用.工作簿.Save() 调用.工作簿.Close() 电子表格.Quit() Dim 电子表格2 As New Excel.Application() '二年级 电子表格2.Visible = True 调用.工作簿 = 电子表格2.Workbooks.Open("C:\Documents and Settings\Administrator\桌面\成绩统计\二年级.xls") 调用.填数据(2) 调用.工作簿.Save() 调用.工作簿.Close() 电子表格2.Quit() Dim 电子表格3 As New Excel.Application() '三年级 电子表格3.Visible = True 调用.工作簿 = 电子表格3.Workbooks.Open("C:\Documents and Settings\Administrator\桌面\成绩统计\三年级.xls") 调用.填数据(3) 调用.工作簿.Save() 调用.工作簿.Close() 电子表格3.Quit() Dim 电子表格4 As New Excel.Application() '四年级 电子表格4.Visible = True 调用.工作簿 = 电子表格4.Workbooks.Open("C:\Documents and Settings\Administrator\桌面\成绩统计\四年级.xls") 调用.填数据(4) 调用.工作簿.Save() 调用.工作簿.Close() 电子表格4.Quit() Dim 电子表格5 As New Excel.Application() '五年级 电子表格5.Visible = True 调用.工作簿 = 电子表格5.Workbooks.Open("C:\Documents and Settings\Administrator\桌面\成绩统计\五年级.xls") 调用.填数据(5) 调用.工作簿.Save() 调用.工作簿.Close() 电子表格5.Quit() Dim 电子表格6 As New Excel.Application() '六年级 电子表格6.Visible = True 调用.工作簿 = 电子表格2.Workbooks.Open("C:\Documents and Settings\Administrator\桌面\成绩统计\六年级.xls") 调用.填数据(6) 调用.工作簿.Save() 调用.工作簿.Close() 电子表格6.Quit() End Sub Private Sub 全部清ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 全部清ToolStripMenuItem.Click Dim 电子表格 As New Excel.Application() '一年级 电子表格.Visible = True 调用.工作簿 = 电子表格.Workbooks.Open("C:\Documents and Settings\Administrator\桌面\成绩统计\一年级.xls") 调用.清数据(1) 调用.工作簿.Save() 调用.工作簿.Close() 电子表格.Quit() Dim 电子表格2 As New Excel.Application() '二年级 电子表格2.Visible = True 调用.工作簿 = 电子表格2.Workbooks.Open("C:\Documents and Settings\Administrator\桌面\成绩统计\二年级.xls") 调用.清数据(2) 调用.工作簿.Save() 调用.工作簿.Close() 电子表格2.Quit() Dim 电子表格3 As New Excel.Application() '三年级 电子表格3.Visible = True 调用.工作簿 = 电子表格3.Workbooks.Open("C:\Documents and Settings\Administrator\桌面\成绩统计\三年级.xls") 调用.清数据(3) 调用.工作簿.Save() 调用.工作簿.Close() 电子表格3.Quit() Dim 电子表格4 As New Excel.Application() '四年级 电子表格4.Visible = True 调用.工作簿 = 电子表格4.Workbooks.Open("C:\Documents and Settings\Administrator\桌面\成绩统计\四年级.xls") 调用.清数据(4) 调用.工作簿.Save() 调用.工作簿.Close() 电子表格4.Quit() Dim 电子表格5 As New Excel.Application() '五年级 电子表格5.Visible = True 调用.工作簿 = 电子表格5.Workbooks.Open("C:\Documents and Settings\Administrator\桌面\成绩统计\五年级.xls") 调用.清数据(5) 调用.工作簿.Save() 调用.工作簿.Close() 电子表格5.Quit() Dim 电子表格6 As New Excel.Application() '六年级 电子表格6.Visible = True 调用.工作簿 = 电子表格2.Workbooks.Open("C:\Documents and Settings\Administrator\桌面\成绩统计\六年级.xls") 调用.清数据(6) 调用.工作簿.Save() 调用.工作簿.Close() 电子表格6.Quit() End Sub Private Sub 一年级ToolStripMenuItem3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 一年级ToolStripMenuItem3.Click 调用.打开() 调用.算成绩(1) 调用.过成绩(1) 调用.单科汇总() 调用.无英语学校汇总(1) End Sub Private Sub 二年级ToolStripMenuItem3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 二年级ToolStripMenuItem3.Click 调用.打开() 调用.算成绩(2) 调用.过成绩(2) 调用.单科汇总() 调用.无英语学校汇总(2) End Sub Private Sub 三年级ToolStripMenuItem3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 三年级ToolStripMenuItem3.Click 调用.打开() 调用.算成绩(3) 调用.过成绩(3) 调用.单科汇总() 调用.有英语学校汇总(3) End Sub Private Sub 四年级ToolStripMenuItem3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 四年级ToolStripMenuItem3.Click 调用.打开() 调用.算成绩(4) 调用.过成绩(4) 调用.单科汇总() 调用.有英语学校汇总(4) End Sub Private Sub 五年级ToolStripMenuItem3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 五年级ToolStripMenuItem3.Click 调用.打开() 调用.算成绩(5) 调用.过成绩(5) 调用.单科汇总() 调用.有英语学校汇总(5) End Sub Private Sub 六年级ToolStripMenuItem3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 六年级ToolStripMenuItem3.Click 调用.打开() 调用.算成绩(6) 调用.过成绩(6) 调用.单科汇总() 调用.有英语学校汇总(6) End Sub Private Sub 子程序目录ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 子程序目录ToolStripMenuItem.Click System.Diagnostics.Process.Start("程序清单.doc") End Sub End Class Public Class 子程序 Public 电子表格 As Excel.Application '定义变量 Public 工作簿 As Excel.Workbook Public 工作表 As Excel.Worksheet Public 单元格 As Excel.Range Dim gbrs(6, 8) As Integer Dim hgrs(6, 8) As Integer Public Structure banji Dim xkrs As Integer '学科人数 Dim xkzf As Integer '学科总分 Dim xkjgr As Integer '学科及格人数 Dim xkyxr As Integer '学科优秀人数 Dim xkjunf As Long '学科均分 Dim xkjf As Long '学科积分 End Structure Public Structure chji Dim nji As String '年级 Dim xm As String '校名 Dim kh As String '考号 Dim xs As String '学生姓名 Dim ywcj As String '语文成绩 Dim sxcj As String '数学成绩 Dim yycj As String '英语成绩 End Structure Dim xx() As String = {"南村1", "南村2", "兴中", "东风", "尧场", "峪头", "普乐塬", "西沟"} Dim kmb() As String = {"语文", "数学", "英语"} Dim nj() As String = {"", "一年级", "二年级", "三年级", "四年级", "五年级", "六年级"} Dim chj(300) As chji '全局变量 Public Function junf(ByRef rs As Double, ByRef zf As Double) As Double '算均分的函数 Return Math.Round(zf / rs, 2) End Function Public Function jf(ByRef rs As Double, ByRef zf As Double, ByRef jgr As Double, ByRef yxr As Double) '算积分的函数 Return Math.Round(zf / rs * 0.6 + jgr / rs * 25 + yxr / rs * 15, 2) End Function Dim bj(6, 8, 3) As banji Dim path As String Dim chjjs = 0 Sub 建空表(ByRef m) 电子表格 = CreateObject("Excel.Application") '创建EXCEL对象 电子表格.SheetsInNewWorkbook = m '创建工作簿 工作簿 = 电子表格.Workbooks.Add 电子表格.Visible = True '设置EXCEL对象可见（或不可见） End Sub Sub 工作表命名(ByRef m) If m < 3 Then '为一二年级工作簿中的每张工作表命名 For i = 1 To 8 Dim 工作表 = 工作簿.Worksheets(i) 工作表.Name = xx(i - 1) Next For j = 1 To 2 Dim 工作表 = 工作簿.Worksheets(8 + j) 工作表.Name = kmb(j - 1) Next End If If m > 2 Then '为三至六年级工作簿中的每张工作表命名 For i = 1 To 5 Dim 工作表 = 工作簿.Worksheets(i) 工作表.Name = xx(i - 1) Next For j = 1 To 3 Dim 工作表 = 工作簿.Worksheets(5 + j) 工作表.Name = kmb(j - 1) Next End If End Sub Sub 成绩册(ByRef m) gbrs(1, 1) = 31 : gbrs(1, 2) = 31 : gbrs(1, 3) = 23 : gbrs(1, 4) = 28 : gbrs(1, 5) = 13 : gbrs(1, 6) = 17 : gbrs(1, 7) = 10 : gbrs(1, 8) = 10 gbrs(2, 1) = 35 : gbrs(2, 2) = 35 : gbrs(2, 3) = 36 : gbrs(2, 4) = 22 : gbrs(2, 5) = 21 : gbrs(2, 6) = 19 : gbrs(2, 7) = 17 : gbrs(2, 8) = 12 gbrs(3, 1) = 36 : gbrs(3, 2) = 36 : gbrs(3, 3) = 45 : gbrs(3, 4) = 39 : gbrs(3, 5) = 17 gbrs(4, 1) = 41 : gbrs(4, 2) = 41 : gbrs(4, 3) = 38 : gbrs(4, 4) = 42 : gbrs(4, 5) = 21 gbrs(5, 1) = 39 : gbrs(5, 2) = 39 : gbrs(5, 3) = 39 : gbrs(5, 4) = 49 : gbrs(5, 5) = 17 gbrs(6, 1) = 42 : gbrs(6, 2) = 42 : gbrs(6, 3) = 43 : gbrs(6, 4) = 54 : gbrs(6, 5) = 14 Dim bglx As String For Each gzb In 工作簿.Worksheets gzb.activate() Dim xxbh As Integer If m < 3 Then gzb.Range("a1:e1").Merge() '合并，为一二年级表头 If m > 2 Then gzb.Range("a1:f1").Merge() '合并，为三至六年级表头 Dim gzbm = gzb.name If gzbm = "语文" Then Call 单科统计表(m, 0) bglx = "单科统计表" gzb.PageSetup.Orientation = XlPageOrientation.xlLandscape '横向打印 End If If gzbm = "数学" Then Call 单科统计表(m, 1) bglx = "单科统计表" gzb.PageSetup.Orientation = XlPageOrientation.xlLandscape '横向打印 End If If gzbm = "英语" Then Call 单科统计表(m, 2) bglx = "单科统计表" gzb.PageSetup.Orientation = XlPageOrientation.xlLandscape '横向打印 End If '学校编号及表格类型 If Left(gzbm, 2) = "南村" or gzbm = "峪头" Then xxbh = 1 : bglx = "成绩册" If gzbm = "东风" or gzbm = "西沟" Then xxbh = 2 : bglx = "成绩册" If gzbm = "兴中" or gzbm = "普乐塬" Then xxbh = 3 : bglx = "成绩册" If gzbm = "尧场" Then xxbh = 4 : bglx = "成绩册" '表头 If gzbm = "南村1" Then gzb.range("a1") = "南村小学" & nj(m) & "1班成绩册" If gzbm = "南村2" Then gzb.range("a1") = "南村小学" & nj(m) & "2班成绩册" If Left(gzbm, 2) <> "南村" And bglx = "成绩册" Then gzb.application.Range("a1") = gzbm & "小学" & nj(m) & "成绩册" If bglx = "成绩册" Then With gzb .Range("a2") = "考号" : .Range("b2") = "姓名" : .Range("c2") = "语文" : .Range("d2") = "数学" End With If m < 3 Then gzb.range("e2") = "总分" If m > 2 Then gzb.range("e2") = "英语" : gzb.range("f2") = "总分" '编考号 For bianhao = 1 To gbrs(m, xxbh) gzb.Range("a" & bianhao + 2).NumberFormat = "00000" If bianhao = 1 Then gzb.Range("a" & bianhao + 2) = "0" & xxbh & m & "01" Else Dim xh = gzb.application.WorksheetFunction.Sum(gzb.Range("a" & bianhao + 1), 0) gzb.Range("a" & bianhao + 2) = xh + 1 End If Next bianhao If m < 3 Then gzb.range(gzb.range("a1"), gzb.range("e" & gbrs(m, xxbh) + 2)).HorizontalAlignment = Excel.Constants.xlCenter '水平居中 gzb.range(gzb.range("a2"), gzb.range("e" & gbrs(m, xxbh) + 2)).Borders.LineStyle = 1 '表格加线 纵排(gbrs(m, xxbh) + 2, 5) End If If m > 2 Then gzb.range(gzb.range("a1"), gzb.range("f" & gbrs(m, xxbh) + 2)).HorizontalAlignment = Excel.Constants.xlCenter '水平居中 gzb.range(gzb.range("a2"), gzb.range("f" & gbrs(m, xxbh) + 2)).Borders.LineStyle = 1 '表格加线 纵排(gbrs(m, xxbh) + 2, 6) End If End If Next gzb End Sub Sub 横排(ByRef h, ByRef l) Dim 工作表 = 工作簿.Worksheets 工作表.Application.Rows("1:" & h).RowHeight = 工作表.Application.CentimetersToPoints(Math.Round((21 - 3 * 2) / h, 2)) 工作表.Application.Columns("a").ColumnWidth = 16.13 工作表.Application.Range(工作表.Application.Cells(2, 2), 工作表.Application.Cells(h, l)).ColumnWidth = Math.Round((29.7 - 3.69 - 1.9 * 2) / (l - 1) * 4.374, 2) 单元格 = 工作表.Application.Range(工作表.Application.Range("a1"), 工作表.Application.Range("a" & h)) 单元格.HorizontalAlignment = Excel.Constants.xlCenter '水平居中 单元格.RowHeight = 电子表格.Application.CentimetersToPoints(Math.Round((21.3 - 3 * 2) / h, 2)) '行高 工作表.Application.Range(工作表.Application.Cells(2, 1), 工作表.Application.Cells(11, 1)).ColumnWidth = 16.13 '列宽 工作表.Application.Range(工作表.Application.Cells(2, 2), 工作表.Application.Cells(h, 1)).ColumnWidth = Math.Round((29.7 - 3.69 - 1.9 * 2) / (l - 1) * 4.374, 2) Dim dygzb = 工作簿.ActiveSheet dygzb.PageSetup.Orientation = 2 '页面横向 End Sub Sub 纵排(ByRef h, ByRef l) Dim 工作表 = 工作簿.Worksheets 工作表.Application.Rows("1:" & h).RowHeight = 工作表.Application.CentimetersToPoints(Math.Round((29.7 - 3 * 2) / h, 2)) '行高 工作表.Application.Range(工作表.Application.Cells(2, 1), 工作表.Application.Cells(h, l)).ColumnWidth = Math.Round((21 - 1.9 * 2) / l * 4.3, 2) '列宽 End Sub Sub 单科统计表(ByRef m, ByRef n) 'm表示年级，n表示科目 xx(0) = "南村1" : xx(1) = "南村2" : xx(2) = "兴中" : xx(3) = "东风" : xx(7) = "西沟" : xx(5) = "峪头" : xx(6) = "普乐塬" : xx(4) = "尧场" kmb(0) = "语文" : kmb(1) = "数学" : kmb(2) = "英语" nj(1) = "一年级" : nj(2) = "二年级" : nj(3) = "三年级" : nj(4) = "四年级" : nj(5) = "五年级" : nj(6) = "六年级" gbrs(1, 1) = 31 : gbrs(1, 2) = 31 : gbrs(1, 3) = 23 : gbrs(1, 4) = 28 : gbrs(1, 5) = 13 : gbrs(1, 6) = 17 : gbrs(1, 7) = 10 : gbrs(1, 8) = 10 gbrs(2, 1) = 35 : gbrs(2, 2) = 35 : gbrs(2, 3) = 36 : gbrs(2, 4) = 22 : gbrs(2, 5) = 21 : gbrs(2, 6) = 19 : gbrs(2, 7) = 17 : gbrs(2, 8) = 12 gbrs(3, 1) = 36 : gbrs(3, 2) = 36 : gbrs(3, 3) = 45 : gbrs(3, 4) = 39 : gbrs(3, 5) = 17 gbrs(4, 1) = 41 : gbrs(4, 2) = 41 : gbrs(4, 3) = 38 : gbrs(4, 4) = 42 : gbrs(4, 5) = 21 gbrs(5, 1) = 39 : gbrs(5, 2) = 39 : gbrs(5, 3) = 39 : gbrs(5, 4) = 49 : gbrs(5, 5) = 17 gbrs(6, 1) = 42 : gbrs(6, 2) = 42 : gbrs(6, 3) = 43 : gbrs(6, 4) = 54 : gbrs(6, 5) = 14 Dim l As Integer If m < 3 Then l = 8 'l表示班级数 If m > 2 Then l = 5 Dim 工作表 = 工作簿.Worksheets 工作表.Application.Range(工作表.Application.Range("a1"), 工作表.Application.Cells(1, l + 2)).Merge() 工作表.Application.Cells(1, 1) = nj(m) + kmb(n) + "成绩统计表" 工作表.Application.Cells(2, l + 2) = "合计" With (工作表.Application) .Cells(2, 1) = "学校" : .Cells(3, 1) = "任课教师" .Cells(4, 1) = "人数" : .Cells(5, 1) = "总分" : .Cells(6, 1) = "均分" : .Cells(7, 1) = "及格人数" : .Cells(8, 1) = "优秀人数" .Cells(9, 1) = "积分" : .Cells(10, 1) = "与年级分之差" : .Cells(11, 1) = "名次" : .Cells(2, l + 2) = "合计" End With For i = 1 To l 工作表.Application.Cells(2, i + 1) = xx(i - 1) 工作表.Application.Cells(4, i + 1) = gbrs(m, i) Next 工作表.Application.Range(工作表.Application.Range("a1"), 工作表.Application.Cells(11, l + 2)).HorizontalAlignment = Excel.Constants.xlCenter '居中 工作表.Application.Range(工作表.Application.Range("a2"), 工作表.Application.Cells(11, l + 2)).Borders.LineStyle = 1 '表格加线 Call 横排(11, l + 2) End Sub Sub 算分栏(ByRef h As Integer, ByRef l As Integer) Dim 工作表 = 工作簿.ActiveSheet For i = 1 To 4 工作表.range(工作表.Range("a" & h + i - 1), 工作表.Range("b" & h + i - 1)).Merge() '合并 Next 工作表.application.range("a" & h) = "总分" 工作表.application.range("a" & h + 1) = "及格人数" 工作表.application.range("a" & h + 2) = "优秀人数" 工作表.application.range("a" & h + 3) = "积分" 工作表.range(工作表.Range("a" & h), 工作表.cells(h + 3, l)).HorizontalAlignment = Excel.Constants.xlCenter '居中 工作表.range(工作表.Range("a" & h), 工作表.cells(h + 3, l)).Borders.LineStyle = 1 '表格加线 End Sub Sub 上报表() For i = 1 To 2 Dim gzb = 工作簿.Worksheets(i) gzb.activate() If i = 1 Then gzb.name = "中心校" gzb.Cells(1, 1) = "中心小学各年级成绩统计表" gzb.Cells(2, 1) = "填报单位：东风镇" + "中心小学" gzb.Cells(20, 1) = "校长：乔晓明" End If If i = 2 Then gzb = 工作簿.Worksheets("sheet2") gzb.name = "普小" gzb.Cells(1, 1) = "镇（社区）小学各年级成绩统计表" gzb.Cells(2, 1) = "填报单位：东风镇" + "辅导站" gzb.Cells(20, 1) = "辅导站长：乔晓明" End If gzb.Range(gzb.Cells(1, 1), gzb.Cells(1, 8)).MergeCells = True gzb.Range(gzb.Cells(2, 1), gzb.Cells(2, 3)).MergeCells = True gzb.Range(gzb.Cells(2, 6), gzb.Cells(2, 8)).MergeCells = True gzb.Range(gzb.Cells(20, 1), gzb.Cells(20, 3)).MergeCells = True gzb.Cells(2, 6) = "填报时间：2012年1月" gzb.Cells(3, 1) = "年级" gzb.Cells(3, 2) = "科目" gzb.Cells(3, 3) = "人数" gzb.Cells(3, 4) = "总分" gzb.Cells(3, 5) = "均分" gzb.Cells(3, 6) = "及格人数" gzb.Cells(3, 7) = "优秀人数" gzb.Cells(3, 8) = "合格人数" For i1 = 1 To 2 gzb.Range(gzb.Cells(i1 * 2 + 2, 1), gzb.Cells(i1 * 2 + 3, 1)).MergeCells = True gzb.Cells(i1 * 2 + 2, 2) = "语文" gzb.Cells(i1 * 2 + 3, 2) = "数学" Next For i2 = 1 To 4 gzb.Range(gzb.Cells(i2 * 3 + 5, 1), gzb.Cells(i2 * 3 + 7, 1)).MergeCells = True gzb.Cells(i2 * 3 + 5, 2) = "语文" gzb.Cells(i2 * 3 + 6, 2) = "数学" gzb.Cells(i2 * 3 + 7, 2) = "英语" Next gzb.Cells(4, 1) = "一" gzb.Cells(6, 1) = "二" gzb.Cells(8, 1) = "三" gzb.Cells(11, 1) = "四" gzb.Cells(14, 1) = "五" gzb.Cells(17, 1) = "六" gzb.Range(gzb.Cells(20, 6), gzb.Cells(20, 8)).MergeCells = True gzb.Cells(20, 6) = "填表人：" gzb.Range(gzb.Cells(1, 1), gzb.Cells(20, 8)).HorizontalAlignment = Excel.Constants.xlCenter gzb.Range(gzb.Cells(3, 1), gzb.Cells(19, 8)).Borders.LineStyle = 1 纵排(20, 8) Next End Sub Sub 填数据(ByRef m As Integer) Dim sjs = New Random() Dim bglx As String For Each gzb In 工作簿.Worksheets gzb.activate() Dim gzbm = gzb.name If Left(gzbm, 2) = "语文" or Left(gzbm, 2) = "数学" or Left(gzbm, 2) = "英语" Then bglx = "单科统计表" Else bglx = "成绩册" End If If bglx = "成绩册" Then Dim n = gzb.Application.WorksheetFunction.CountA(gzb.Range(gzb.Cells(2, 1), gzb.Cells(60, 1))) - 1 '考试人数 Dim l = gzb.Application.WorksheetFunction.Match("语文", gzb.Range(gzb.Cells(2, 1), gzb.Cells(2, 5)), 0) ' "语文 "所在列数 For i = 1 To n gzb.Cells(i + 2, l) = sjs.Next(100) '语文 gzb.Cells(i + 2, l + 1) = sjs.Next(100) '数学 Next If m > 2 Then For i = 1 To n gzb.cells(i + 2, l + 2) = sjs.Next(100) '英语 Next End If End If Next End Sub Sub 打开() Dim openFileDialog1 = New OpenFileDialog() openFileDialog1.Title = "请选择文件：" openFileDialog1.Filter = "所有文件(*.*)|*.*|所有文件(*.*)|*.*" openFileDialog1.FilterIndex = 1 openFileDialog1.RestoreDirectory = False If (openFileDialog1.ShowDialog() = DialogResult.OK) Then path = openFileDialog1.FileName 电子表格 = CreateObject("Excel.Application") '创建EXCEL对象 工作簿 = 电子表格.Workbooks.Open(path) 电子表格.Visible = True '设置EXCEL对象可见 End If End Sub Sub 清数据(ByRef m As Integer) Dim bglx As String For Each gzb In 工作簿.Worksheets gzb.activate() Dim gzbm = gzb.name If Left(gzbm, 2) = "语文" or Left(gzbm, 2) = "数学" or Left(gzbm, 2) = "英语" Then bglx = "单科统计表" Else bglx = "成绩册" End If If bglx = "成绩册" Then Dim n = gzb.Application.WorksheetFunction.CountA(gzb.Range(gzb.Cells(2, 1), gzb.Cells(60, 1))) - 1 '考试人数 Dim l = gzb.Application.WorksheetFunction.Match("语文", gzb.Range(gzb.Cells(2, 1), gzb.Cells(2, 5)), 0) ' "语文 "所在列数 For i = 1 To n gzb.Cells(i + 2, l) = "" '语文 gzb.Cells(i + 2, l + 1) = "" '数学 gzb.cells(i + 2, l + 2) = "" '英语 Next End If Next End Sub Sub 算成绩(ByRef m As Integer) Dim bglx As String Dim q = 0 For Each gzb In 工作簿.Worksheets gzb.activate() Dim gzbm = gzb.name q = q + 1 If Left(gzbm, 2) = "语文" or Left(gzbm, 2) = "数学" or Left(gzbm, 2) = "英语" Then bglx = "单科统计表" Else bglx = "成绩册" End If If bglx = "成绩册" Then Dim n = 0 '考试人数 Dim zfl = gzb.Application.WorksheetFunction.Match("总分", gzb.Range(gzb.Cells(2, 1), gzb.Cells(2, 6)), 0) '总分列 Dim n2 = gzb.Application.WorksheetFunction.Match("合格人数", gzb.Range(gzb.Cells(2, zfl), gzb.Cells(60, zfl)), 0) '合格人数所在行数 Dim n1 = gzb.Application.WorksheetFunction.CountA(gzb.Range(gzb.Cells(3, 1), gzb.Cells(60, 1))) '非空单元格个数 If n2 = 0 And n1 > 0 Then n = n1 If n2 > 0 Then n = n2 - 2 Dim l = gzb.Application.WorksheetFunction.Match("语文", gzb.Range(gzb.Cells(2, 1), gzb.Cells(2, 5)), 0) ' "语文 "所在列数 bj(m - 1, q - 1, 0).xkrs = n '语文人数 bj(m - 1, q - 1, 1).xkrs = n '数学人数 bj(m - 1, q - 1, 0).xkzf = gzb.Application.WorksheetFunction.Sum(gzb.Range(gzb.Cells(3, l), gzb.Cells(bj(m - 1, q - 1, 0).xkrs + 2, l))) '语文总分 bj(m - 1, q - 1, 1).xkzf = gzb.Application.WorksheetFunction.Sum(gzb.Range(gzb.Cells(3, l + 1), gzb.Cells(bj(m - 1, q - 1, 0).xkrs + 2, l + 1))) '数学总分 bj(m - 1, q - 1, 0).xkjgr = gzb.Application.WorksheetFunction.CountIf(gzb.Range(gzb.Cells(3, l), gzb.Cells(bj(m - 1, q - 1, 0).xkrs + 2, l)), ">59") '语文及格人数 bj(m - 1, q - 1, 1).xkjgr = gzb.Application.WorksheetFunction.CountIf(gzb.Range(gzb.Cells(3, l + 1), gzb.Cells(bj(m - 1, q - 1, 0).xkrs + 2, l + 1)), ">59") '数学及格人数 bj(m - 1, q - 1, 0).xkyxr = gzb.Application.WorksheetFunction.CountIf(gzb.Range(gzb.Cells(3, l), gzb.Cells(bj(m - 1, q - 1, 0).xkrs + 2, l)), ">79") '语文优秀人数 bj(m - 1, q - 1, 1).xkyxr = gzb.Application.WorksheetFunction.CountIf(gzb.Range(gzb.Cells(3, l + 1), gzb.Cells(bj(m - 1, q - 1, 0).xkrs + 2, l + 1)), ">79") '数学优秀人数 gzb.Cells(bj(m - 1, q - 1, 0).xkrs + 3, l) = bj(m - 1, q - 1, 0).xkzf '在成绩单上输出成绩 gzb.Cells(bj(m - 1, q - 1, 1).xkrs + 3, l + 1) = bj(m - 1, q - 1, 1).xkzf '语文、数学总分 gzb.Cells(bj(m - 1, q - 1, 0).xkrs + 4, l) = bj(m - 1, q - 1, 0).xkjgr gzb.Cells(bj(m - 1, q - 1, 1).xkrs + 4, l + 1) = bj(m - 1, q - 1, 1).xkjgr '语文、数学及格人数 gzb.Cells(bj(m - 1, q - 1, 0).xkrs + 5, l) = bj(m - 1, q - 1, 0).xkyxr gzb.Cells(bj(m - 1, q - 1, 1).xkrs + 5, l + 1) = bj(m - 1, q - 1, 1).xkyxr '语文、数学优秀人数 bj(m - 1, q - 1, 0).xkjf = jf(bj(m - 1, q - 1, 0).xkrs, bj(m - 1, q - 1, 0).xkzf, bj(m - 1, q - 1, 0).xkjgr, bj(m - 1, q - 1, 0).xkyxr) bj(m - 1, q - 1, 0).xkjunf = junf(bj(m - 1, q - 1, 0).xkrs, bj(m - 1, q - 1, 0).xkzf) gzb.Cells(bj(m - 1, q - 1, 0).xkrs + 6, l) = bj(m - 1, q - 1, 0).xkjf '语文积分 bj(m - 1, q - 1, 1).xkjf = jf(bj(m - 1, q - 1, 1).xkrs, bj(m - 1, q - 1, 1).xkzf, bj(m - 1, q - 1, 1).xkjgr, bj(m - 1, q - 1, 1).xkyxr) bj(m - 1, q - 1, 1).xkjunf = junf(bj(m - 1, q - 1, 1).xkrs, bj(m - 1, q - 1, 1).xkzf) gzb.Cells(bj(m - 1, q - 1, 1).xkrs + 6, l + 1) = bj(m - 1, q - 1, 1).xkjf '数学积分 If m > 2 Then bj(m - 1, q - 1, 2).xkzf = gzb.Application.WorksheetFunction.Sum(gzb.Range(gzb.Cells(3, l + 2), gzb.Cells(bj(m - 1, q - 1, 0).xkrs + 2, l + 2))) '英语总分 bj(m - 1, q - 1, 2).xkjgr = gzb.Application.WorksheetFunction.CountIf(gzb.Range(gzb.Cells(3, l + 2), gzb.Cells(bj(m - 1, q - 1, 0).xkrs + 2, l + 2)), ">59") '英语及格人数 bj(m - 1, q - 1, 2).xkyxr = gzb.Application.WorksheetFunction.CountIf(gzb.Range(gzb.Cells(3, l + 2), gzb.Cells(bj(m - 1, q - 1, 0).xkrs + 2, l + 2)), ">79") '英语优秀人数 gzb.Cells(bj(m - 1, q - 1, 0).xkrs + 3, l + 2) = bj(m - 1, q - 1, 2).xkzf gzb.Cells(bj(m - 1, q - 1, 0).xkrs + 4, l + 2) = bj(m - 1, q - 1, 2).xkjgr gzb.Cells(bj(m - 1, q - 1, 0).xkrs + 5, l + 2) = bj(m - 1, q - 1, 2).xkyxr bj(m - 1, q - 1, 2).xkrs = bj(m - 1, q - 1, 0).xkrs bj(m - 1, q - 1, 2).xkjf = jf(bj(m - 1, q - 1, 2).xkrs, bj(m - 1, q - 1, 2).xkzf, bj(m - 1, q - 1, 2).xkjgr, bj(m - 1, q - 1, 2).xkyxr) bj(m - 1, q - 1, 2).xkjunf = junf(bj(m - 1, q - 1, 2).xkrs, bj(m - 1, q - 1, 2).xkzf) gzb.Cells(bj(m - 1, q - 1, 0).xkrs + 6, l + 2) = bj(m - 1, q - 1, 2).xkjf '英语积分 End If Dim hg = 0 '计算个人总分,统计合格人数 For i = 3 To bj(m - 1, q - 1, 0).xkrs + 2 Dim yuwen = gzb.Application.WorksheetFunction.Sum(gzb.Cells(i, l), 0) Dim shuxue = gzb.Application.WorksheetFunction.Sum(gzb.Cells(i, l + 1), 0) Dim yingyu = gzb.Application.WorksheetFunction.Sum(gzb.Cells(i, l + 2), 0) If m < 3 Then gzb.Cells(i, l + 2) = yuwen + shuxue If (m > 2) Then gzb.Cells(i, l + 3) = yuwen + shuxue + yingyu If m < 3 And yuwen > 59 And shuxue > 59 Then hg = hg + 1 '统计及格人数 If m > 2 And yuwen > 59 And shuxue > 59 And yingyu > 59 Then hg = hg + 1 Next If m < 3 Then gzb.Cells(bj(m - 1, q - 1, 0).xkrs + 3, l + 2) = "合格人数" gzb.Cells(bj(m - 1, q - 1, 0).xkrs + 4, l + 2) = hg hgrs(m - 1, q - 1) = hg End If If m > 2 Then gzb.Cells(bj(m - 1, q - 1, 0).xkrs + 3, l + 3) = "合格人数" gzb.Cells(bj(m - 1, q - 1, 0).xkrs + 4, l + 3) = hg hgrs(m - 1, q - 1 + 1) = hg End If 算分栏(n + 3, zfl) gzb.range(gzb.range("a1"), gzb.cells(n + 6, zfl)).HorizontalAlignment = Excel.Constants.xlCenter '水平居中 纵排(n + 6, zfl) End If Next End Sub Sub 过成绩(ByRef m As Integer) Dim bglx As String Dim qq As Integer Dim bjs As Integer '班级数 If m > 2 Then bjs = 5 If m < 3 Then bjs = 8 For Each gzb In 工作簿.Worksheets gzb.activate() Dim gzbm = gzb.name If Left(gzbm, 2) = "语文" or Left(gzbm, 2) = "数学" or Left(gzbm, 2) = "英语" Then bglx = "单科统计表" Else bglx = "成绩册" End If If gzbm = "语文" Then qq = 0 If gzbm = "数学" Then qq = 1 If gzbm = "英语" Then qq = 2 If bglx = "单科统计表" Then For q = 1 To bjs Dim kml = gzb.Application.WorksheetFunction.Match(xx(q - 1), gzb.Range(gzb.Cells(2, 1), gzb.Cells(2, 10)), 0) '寻找学校所在列 gzb.Cells(4, kml) = bj(m - 1, q - 1, qq).xkrs '过录人数 gzb.Cells(5, kml) = bj(m - 1, q - 1, qq).xkzf '过录总分 gzb.Cells(6, kml) = bj(m - 1, q - 1, qq).xkjunf '均分 gzb.Cells(7, kml) = bj(m - 1, q - 1, qq).xkjgr '过录及格人数 gzb.Cells(8, kml) = bj(m - 1, q - 1, qq).xkyxr '过录优秀人数 gzb.Cells(9, kml) = bj(m - 1, q - 1, qq).xkjf '积分 Next End If Next End Sub Sub 单科汇总() Dim bglx As String For Each gzb In 工作簿.Worksheets gzb.activate() Dim gzbm = gzb.name If Left(gzbm, 2) = "语文" or Left(gzbm, 2) = "数学" or Left(gzbm, 2) = "英语" Then bglx = "单科统计表" Else bglx = "成绩册" End If If bglx = "单科统计表" Then Dim hjl = gzb.Application.WorksheetFunction.Match("合计", gzb.Range(gzb.Cells(2, 1), gzb.Cells(2, 11)), 0) '寻找合计列 Dim zrs = gzb.Application.WorksheetFunction.Sum(gzb.range(gzb.Cells(4, 2), gzb.cells(4, hjl - 1)), 0) '计算总人数 Dim zzf = gzb.Application.WorksheetFunction.Sum(gzb.range(gzb.Cells(5, 2), gzb.cells(5, hjl - 1)), 0) '计算总分 Dim zjgr = gzb.Application.WorksheetFunction.Sum(gzb.range(gzb.Cells(7, 2), gzb.cells(7, hjl - 1)), 0) '计算总及格人数 Dim zyxr = gzb.Application.WorksheetFunction.Sum(gzb.range(gzb.Cells(8, 2), gzb.cells(8, hjl - 1)), 0) '计算总优秀人数 Dim zjunf = junf(zrs, zzf) Dim zjf = jf(zrs, zzf, zjgr, zyxr) gzb.Cells(4, hjl) = zrs '学科人数 gzb.Cells(5, hjl) = zzf '学科总分 gzb.Cells(6, hjl) = zjunf '学科均分 gzb.Cells(7, hjl) = zjgr '学科及格人数 gzb.Cells(8, hjl) = zyxr '学科优秀人数 gzb.Cells(9, hjl) = zjf '学科积分 For mc = 2 To hjl - 1 gzb.Cells(10, mc) = Math.Round(gzb.Application.WorksheetFunction.Sum(gzb.Cells(9, mc), 0) - gzb.Application.WorksheetFunction.Sum(gzb.Cells(9, hjl), 0), 2) '与学科积分之差 gzb.Cells(11, mc) = gzb.Application.WorksheetFunction.Rank(gzb.Application.WorksheetFunction.Sum(gzb.Cells(9, mc), 0), gzb.Range(gzb.Cells(9, 2), gzb.Cells(9, hjl - 1))) '名次 Next End If Next End Sub Sub 无英语学校汇总(ByRef m As Integer) Dim ncrs() = {0, 0}, dfrs() = {0, 0}, xzrs() = {0, 0}, ycrs() = {0, 0}, ytrs() = {0, 0}, xgrs() = {0, 0}, plyrs() = {0, 0}, zxxrs() = {0, 0}, pxrs() = {0, 0} '人数 Dim nczf() = {0, 0}, dfzf() = {0, 0}, xzzf() = {0, 0}, yczf() = {0, 0}, ytzf() = {0, 0}, xgzf() = {0, 0}, plyzf() = {0, 0}, zxxzf() = {0, 0}, pxzf() = {0, 0} '总分 Dim ncjgr() = {0, 0}, dfjgr() = {0, 0}, xzjgr() = {0, 0}, ycjgr() = {0, 0}, ytjgr() = {0, 0}, xgjgr() = {0, 0}, plyjgr() = {0, 0}, zxxjgr() = {0, 0}, pxjgr() = {0, 0} '及格人数 Dim ncyxr() = {0, 0}, dfyxr() = {0, 0}, xzyxr() = {0, 0}, ycyxr() = {0, 0}, ytyxr() = {0, 0}, xgyxr() = {0, 0}, plyyxr() = {0, 0}, zxxyxr() = {0, 0}, pxyxr() = {0, 0} '优秀人数 Dim ncjunf() = {0, 0}, dfjunf() = {0, 0}, xzjunf() = {0, 0}, ycjunf() = {0, 0}, ytjunf() = {0, 0}, xgjunf() = {0, 0}, plyjunf() = {0, 0}, zxxjunf() = {0, 0}, pxjunf() = {0, 0} '均分 Dim ncjf() = {0, 0}, dfjf() = {0, 0}, xzjf() = {0, 0}, ycjf() = {0, 0}, ytjf() = {0, 0}, xgjf() = {0, 0}, plyjf() = {0, 0}, zxxjf() = {0, 0}, pxjf() = {0, 0} '积分 Dim zxxhgrs = 0, pxhgrs = 0 '中心校合格人数，普小合格人数 For j = 0 To 1 For i = 0 To 7 '学校成绩汇总 If xx(i) = "峪头" Then ytrs(j) = bj(m - 1, i, j).xkrs + ytrs(j) '汇总人数 ytzf(j) = bj(m - 1, i, j).xkzf + ytzf(j) '汇总总分 ytjgr(j) = bj(m - 1, i, j).xkjgr + ytjgr(j) '汇总及格人数 ytyxr(j) = bj(m - 1, i, j).xkyxr + ytyxr(j) '汇总优秀人数 End If If xx(i) = "尧场" Then ycrs(j) = bj(m - 1, i, j).xkrs + ycrs(j) '汇总人数 yczf(j) = bj(m - 1, i, j).xkzf + yczf(j) '汇总总分 ycjgr(j) = bj(m - 1, i, j).xkjgr + ycjgr(j) '汇总及格人数 ycyxr(j) = bj(m - 1, i, j).xkyxr + ycyxr(j) '汇总优秀人数 End If If xx(i) = "东风" or xx(i) = "西沟" Then dfrs(j) = bj(m - 1, i, j).xkrs + dfrs(j) '汇总人数 dfzf(j) = bj(m - 1, i, j).xkzf + dfzf(j) '汇总总分 dfjgr(j) = bj(m - 1, i, j).xkjgr + dfjgr(j) '汇总及格人数 dfyxr(j) = bj(m - 1, i, j).xkyxr + dfyxr(j) '汇总优秀人数 End If If xx(i) = "兴中" or xx(i) = "普乐塬" Then xzrs(j) = bj(m - 1, i, j).xkrs + xzrs(j) '汇总人数 xzzf(j) = bj(m - 1, i, j).xkzf + xzzf(j) '汇总总分 xzjgr(j) = bj(m - 1, i, j).xkjgr + xzjgr(j) '汇总及格人数 xzyxr(j) = bj(m - 1, i, j).xkyxr + xzyxr(j) '汇总优秀人数 End If If xx(i) = "南村1" or xx(i) = "南村2" or xx(i) = "峪头" Then ncrs(j) = bj(m - 1, i, j).xkrs + ncrs(j) '汇总人数 nczf(j) = bj(m - 1, i, j).xkzf + nczf(j) '汇总总分 ncjgr(j) = bj(m - 1, i, j).xkjgr + ncjgr(j) '汇总及格人数 ncyxr(j) = bj(m - 1, i, j).xkyxr + ncyxr(j) '汇总优秀人数 End If Next ncjf(j) = jf(ncrs(j), nczf(j), ncjgr(j), ncyxr(j)) dfjf(j) = jf(dfrs(j), dfzf(j), dfjgr(j), dfyxr(j)) xzjf(j) = jf(xzrs(j), xzzf(j), xzjgr(j), xzyxr(j)) ycjf(j) = jf(ycrs(j), yczf(j), ycjgr(j), ycyxr(j)) zxxrs(j) = ncrs(j) - ytrs(j) '中心校人数 zxxzf(j) = nczf(j) - ytzf(j) '中心校总分 zxxjgr(j) = ncjgr(j) - ytjgr(j) '中心校及格人数 zxxyxr(j) = ncyxr(j) - ytyxr(j) '中心校优秀人数 zxxjunf(j) = junf(zxxrs(j), zxxzf(j)) zxxhgrs = hgrs(m - 1, 0) + hgrs(m - 1, 1) '中心校合格人数 pxrs(j) = dfrs(j) + xzrs(j) + ycrs(j) + ytrs(j) '普小人数 pxzf(j) = dfzf(j) + xzzf(j) + yczf(j) + ytzf(j) '普小总分 pxjgr(j) = dfjgr(j) + xzjgr(j) + ycjgr(j) + ytjgr(j) '普小及格人数 pxyxr(j) = dfyxr(j) + xzyxr(j) + ycyxr(j) + ytyxr(j) '普小优秀人数 pxjunf(j) = junf(pxrs(j), pxzf(j)) pxhgrs = hgrs(m - 1, 2) + hgrs(m - 1, 3) + hgrs(m - 1, 4) + hgrs(m - 1, 5) + hgrs(m - 1, 6) + hgrs(m - 1, 7) '合格人数 Next Dim wjlj = path.Replace(nj(m), "学校总评") Dim 电子表格 = New Excel.Application() '创建EXCEL对象 Dim 工作簿 = 电子表格.Workbooks.Open(wjlj) 电子表格.Visible = True Dim gzb = 工作簿.Sheets("学校积分") gzb.Select() '向学校总评表过录年级数据 gzb.Cells(3, m + 1) = Math.Round(ncjf(0) * 0.5 + ncjf(1) * 0.5, 2) '南村 gzb.Cells(4, m + 1) = Math.Round(dfjf(0) * 0.5 + dfjf(1) * 0.5, 2) '东风 gzb.Cells(5, m + 1) = Math.Round(xzjf(0) * 0.5 + xzjf(1) * 0.5, 2) '兴中 gzb.Cells(6, m + 1) = Math.Round(ycjf(0) * 0.5 + ycjf(1) * 0.5, 2) '尧场 For i = 3 To 6 '填均积分 Dim jfh = gzb.Application.WorksheetFunction.Sum(gzb.Range(gzb.Cells(i, 2), gzb.Cells(i, 7))) gzb.Cells(i, 8) = Math.Round(jfh / 6, 2) Next For i = 3 To 6 '填名次 gzb.Cells(i, 9) = gzb.Application.WorksheetFunction.Rank(gzb.Application.WorksheetFunction.Sum(gzb.Cells(i, 8), 0), gzb.Range(gzb.Cells(3, 8), gzb.Cells(6, 8))) Next 工作簿.Save() 工作簿.Close() Dim lj = path.Replace(nj(m), "上报") Dim 工作簿2 = 电子表格.Workbooks.Open(lj) Dim gzb2 = 工作簿2.Sheets("中心校") gzb2.Select() '填报中心校 gzb2.Cells(m * 2 + 2, 3) = zxxrs(0) gzb2.Cells(m * 2 + 2, 4) = zxxzf(0) gzb2.Cells(m * 2 + 2, 5) = zxxjunf(0) gzb2.Cells(m * 2 + 2, 6) = zxxjgr(0) gzb2.Cells(m * 2 + 2, 7) = zxxyxr(0) gzb2.Cells(m * 2 + 2, 8) = zxxhgrs gzb2.Cells(m * 2 + 3, 3) = zxxrs(1) gzb2.Cells(m * 2 + 3, 4) = zxxzf(1) gzb2.Cells(m * 2 + 3, 5) = zxxjunf(1) gzb2.Cells(m * 2 + 3, 6) = zxxjgr(1) gzb2.Cells(m * 2 + 3, 7) = zxxyxr(1) gzb2.Cells(m * 2 + 3, 8) = zxxhgrs Dim gzb3 = 工作簿2.Sheets("普小") gzb3.Select() '填报普小 gzb3.Cells(m * 2 + 2, 3) = pxrs(0) gzb3.Cells(m * 2 + 2, 4) = pxzf(0) gzb3.Cells(m * 2 + 2, 5) = Math.Round(pxjunf(0), 2) gzb3.Cells(m * 2 + 2, 6) = pxjgr(0) gzb3.Cells(m * 2 + 2, 7) = pxyxr(0) gzb3.Cells(m * 2 + 2, 8) = pxhgrs gzb3.Cells(m * 2 + 3, 3) = pxrs(1) gzb3.Cells(m * 2 + 3, 4) = pxzf(1) gzb3.Cells(m * 2 + 3, 5) = Math.Round(pxjunf(1), 2) gzb3.Cells(m * 2 + 3, 6) = pxjgr(1) gzb3.Cells(m * 2 + 3, 7) = pxyxr(1) gzb3.Cells(m * 2 + 3, 8) = pxhgrs 工作簿2.Save() 工作簿2.Close() 电子表格.Quit() End Sub Sub 有英语学校汇总(ByRef m As Integer) Dim ncrs() = {0, 0, 0}, dfrs() = {0, 0, 0}, xzrs() = {0, 0, 0}, ycrs() = {0, 0, 0}, pxrs() = {0, 0, 0} '人数 Dim nczf() = {0, 0, 0}, dfzf() = {0, 0, 0}, xzzf() = {0, 0, 0}, yczf() = {0, 0, 0}, pxzf() = {0, 0, 0} '总分 Dim ncjgr() = {0, 0, 0}, dfjgr() = {0, 0, 0}, xzjgr() = {0, 0, 0}, ycjgr() = {0, 0, 0}, pxjgr() = {0, 0, 0} '及格人数 Dim ncyxr() = {0, 0, 0}, dfyxr() = {0, 0, 0}, xzyxr() = {0, 0, 0}, ycyxr() = {0, 0, 0}, pxyxr() = {0, 0, 0} '优秀人数 Dim ncjunf() = {0, 0, 0}, dfjunf() = {0, 0, 0}, xzjunf() = {0, 0, 0}, ycjunf() = {0, 0, 0}, zxxjunf() = {0, 0, 0}, pxjunf() = {0, 0, 0} '均分 Dim ncjf() = {0, 0, 0}, dfjf() = {0, 0, 0}, xzjf() = {0, 0, 0}, ycjf() = {0, 0, 0}, zxxjf() = {0, 0, 0}, pxjf() = {0, 0, 0} '积分 Dim zxxhgrs = 0, pxhgrs = 0 '中心校合格人数，普小合格人数 For j = 0 To 2 ycrs(j) = bj(m - 1, 4, j).xkrs '尧场人数 yczf(j) = bj(m - 1, 4, j).xkzf '尧场总分 ycjgr(j) = bj(m - 1, 4, j).xkjgr '尧场及格人数 ycyxr(j) = bj(m - 1, 4, j).xkyxr '尧场优秀人数 dfrs(j) = bj(m - 1, 3, j).xkrs '东风人数 dfzf(j) = bj(m - 1, 3, j).xkzf '东风总分 dfjgr(j) = bj(m - 1, 3, j).xkjgr '东风及格人数 dfyxr(j) = bj(m - 1, 3, j).xkyxr '东风优秀人数 xzrs(j) = bj(m - 1, 2, j).xkrs '兴中人数 xzzf(j) = bj(m - 1, 2, j).xkzf '兴中总分 xzjgr(j) = bj(m - 1, 2, j).xkjgr '兴中及格人数 xzyxr(j) = bj(m - 1, 2, j).xkyxr '兴中优秀人数 pxrs(j) = ycrs(j) + dfrs(j) + xzrs(j) pxzf(j) = yczf(j) + dfzf(j) + xzzf(j) pxjgr(j) = ycjgr(j) + dfjgr(j) + xzjgr(j) pxyxr(j) = ycyxr(j) + dfyxr(j) + xzyxr(j) ncrs(j) = bj(m - 1, 0, j).xkrs + bj(m - 1, 1, j).xkrs '南村人数 nczf(j) = bj(m - 1, 0, j).xkzf + bj(m - 1, 1, j).xkzf '南村总分 ncjgr(j) = bj(m - 1, 0, j).xkjgr + bj(m - 1, 1, j).xkjgr '南村及格人数 ncyxr(j) = bj(m - 1, 0, j).xkyxr + bj(m - 1, 1, j).xkyxr '南村优秀人数 pxjunf(j) = junf(pxrs(j), pxzf(j)) ncjf(j) = jf(ncrs(j), nczf(j), ncjgr(j), ncyxr(j)) zxxjunf(j) = junf(ncrs(j), nczf(j)) dfjf(j) = jf(dfrs(j), dfzf(j), dfjgr(j), dfyxr(j)) xzjf(j) = jf(xzrs(j), xzzf(j), xzjgr(j), xzyxr(j)) ycjf(j) = jf(ycrs(j), yczf(j), ycjgr(j), ycyxr(j)) Next Dim wjlj = path.Replace(nj(m), "学校总评") Dim 电子表格 = New Excel.Application() '创建EXCEL对象 Dim 工作簿 = 电子表格.Workbooks.Open(wjlj) 电子表格.Visible = True Dim gzb = 工作簿.Sheets("学校积分") gzb.Select() '向学校总评表过录年级数据 gzb.Cells(3, m + 1) = Math.Round((ncjf(0) + ncjf(1) + ncjf(2)) / 3, 2) '南村 gzb.Cells(4, m + 1) = Math.Round((dfjf(0) + dfjf(1) + dfjf(2)) / 3, 2) '东风 gzb.Cells(5, m + 1) = Math.Round((xzjf(0) + xzjf(1) + xzjf(2)) / 3, 2) '兴中 gzb.Cells(6, m + 1) = Math.Round((ycjf(0) + ycjf(1) + ycjf(2)) / 3, 2) '尧场 For i = 3 To 6 '填均积分 Dim jfh = gzb.Application.WorksheetFunction.Sum(gzb.Range(gzb.Cells(i, 2), gzb.Cells(i, 7))) gzb.Cells(i, 8) = Math.Round(jfh / 6, 2) Next For i = 3 To 6 '填名次 gzb.Cells(i, 9) = gzb.Application.WorksheetFunction.Rank(gzb.Application.WorksheetFunction.Sum(gzb.Cells(i, 8), 0), gzb.Range(gzb.Cells(3, 8), gzb.Cells(6, 8))) Next zxxhgrs = hgrs(m - 1, 0) + hgrs(m - 1, 1) '中心校合格人数 pxhgrs = hgrs(m - 1, 2) + hgrs(m - 1, 3) + hgrs(m - 1, 4) '普小合格人数 工作簿.Save() 工作簿.Close() Dim lj = path.Replace(nj(m), "上报") Dim 工作簿2 = 电子表格.Workbooks.Open(lj) Dim gzb2 = 工作簿2.Sheets("中心校") gzb2.Select() '填报中心校 gzb2.Cells(m * 3 - 1, 3) = ncrs(0) gzb2.Cells(m * 3 - 1, 4) = nczf(0) gzb2.Cells(m * 3 - 1, 5) = Math.Round(zxxjunf(0), 2) gzb2.Cells(m * 3 - 1, 6) = ncjgr(0) gzb2.Cells(m * 3 - 1, 7) = ncyxr(0) gzb2.Cells(m * 3 - 1, 8) = zxxhgrs gzb2.Cells(m * 3, 3) = ncrs(1) gzb2.Cells(m * 3, 4) = nczf(1) gzb2.Cells(m * 3, 5) = Math.Round(zxxjunf(1), 2) gzb2.Cells(m * 3, 6) = ncjgr(1) gzb2.Cells(m * 3, 7) = ncyxr(1) gzb2.Cells(m * 3, 8) = zxxhgrs gzb2.Cells(m * 3 + 1, 3) = ncrs(2) gzb2.Cells(m * 3 + 1, 4) = nczf(2) gzb2.Cells(m * 3 + 1, 5) = Math.Round(zxxjunf(2), 2) gzb2.Cells(m * 3 + 1, 6) = ncjgr(2) gzb2.Cells(m * 3 + 1, 7) = ncyxr(2) gzb2.Cells(m * 3 + 1, 8) = zxxhgrs Dim gzb3 = 工作簿2.Sheets("普小") gzb3.Select() '填报普小 gzb3.Cells(m * 3 - 1, 3) = pxrs(0) gzb3.Cells(m * 3 - 1, 4) = pxzf(0) gzb3.Cells(m * 3 - 1, 5) = Math.Round(pxjunf(0), 2) gzb3.Cells(m * 3 - 1, 6) = pxjgr(0) gzb3.Cells(m * 3 - 1, 7) = pxyxr(0) gzb3.Cells(m * 3 - 1, 8) = pxhgrs gzb3.Cells(m * 3, 3) = pxrs(1) gzb3.Cells(m * 3, 4) = pxzf(1) gzb3.Cells(m * 3, 5) = Math.Round(pxjunf(1), 2) gzb3.Cells(m * 3, 6) = pxjgr(1) gzb3.Cells(m * 3, 7) = pxyxr(1) gzb3.Cells(m * 3, 8) = pxhgrs gzb3.Cells(m * 3 + 1, 3) = pxrs(2) gzb3.Cells(m * 3 + 1, 4) = pxzf(2) gzb3.Cells(m * 3 + 1, 5) = Math.Round(pxjunf(2), 2) gzb3.Cells(m * 3 + 1, 6) = pxjgr(2) gzb3.Cells(m * 3 + 1, 7) = pxyxr(2) gzb3.Cells(m * 3 + 1, 8) = pxhgrs 工作簿2.Save() 工作簿2.Close() 电子表格.Quit() End Sub End Class |
|
|
