用Excel制作学生成绩条
时间：2005-03-07 12:55 来源：未知 作者：未知 阅读：次
现在很多学校都在使用Excel来处理学生成绩，但是处理完成绩之后，怎样才能将每个学生的成绩以成绩条方式发给学生呢？这可是个头痛的问题，因为处理完成绩之后会发现，成绩表只有一个表头（如：班别、年级、编号、姓名、总分、名次等），如何才能使每一个学生的成绩记录都有一个表头呢？
有的同事这样想：首先在每个学生的成绩记录之前插入一个空白行，然后再将表头复制到空白行上不就可以了吗？刚开始时觉得还是有点道理的，可是后来想了一想，我们学校有2000多学生，如果用这种方法给每位学生的成绩记录制一个表头，那得用多少时间？
如果能自动完成这个过程，那可是最好的，于是我想到了用Excel的VBA来制作学生成绩条。
解决问题的思路
因为每个学生只有一个学号，所以学号是惟一的，根据学号惟一性这一特点，使用VBA里的判断语句，如果学号不同，就在两者之间插入一个空白行，然后再在每个空白行粘贴复制的表头，最后使用循环语句，自动制作每个学生成绩记录的表头。
解决问题的方法
打开学生的成绩表，我们需要另存为另外一个表来制作成绩条，以免影响成绩表的原貌。
在VBA的工程资源管理器中双击Sheet1，然后出现代码窗口，在代码窗口输入如下代码：
Sub cjt()
Application.ScreenUpdating = False
Sheets(1).[A1].CurrentRegion.Copy Sheets(2).[A1]
’将表一的成绩表复制到表二
a=(Application.WorksheetFunction.CountA(Sheets(2).[b2:b2000]))*2
’sheets(1).[b2:b2000]的字符数的2倍
Sheets(2).[A1:R1].Borders(xlEdgeTop).LineStyle = xlDouble
’sheets(2).[a1:r1]的下边框是双线
For i = 2 To a
If Sheets(2).Cells(i, 3) <> Sheets(2).Cells(i + 1, 3) And (Sheets(2).Cells(i, 3) <> "") Then
Sheets(2).Rows(i + 1).Insert
End If
’如果第三列的上下单元格的值不相等，则在它们之间插入一个空白行
If Sheets(2).Cells(i, 3) = "" Then
Sheets(2).[A1:R1].Copy Sheets(2).Cells(i, 1)
End If
’如果第三列中的单元格是空的，则将Sheets(2).[A1:R1]复制到此行
Next
Application.ScreenUpdating = True
End Sub
有的同事这样想：首先在每个学生的成绩记录之前插入一个空白行，然后再将表头复制到空白行上不就可以了吗？刚开始时觉得还是有点道理的，可是后来想了一想，我们学校有2000多学生，如果用这种方法给每位学生的成绩记录制一个表头，那得用多少时间？
如果能自动完成这个过程，那可是最好的，于是我想到了用Excel的VBA来制作学生成绩条。
解决问题的思路
因为每个学生只有一个学号，所以学号是惟一的，根据学号惟一性这一特点，使用VBA里的判断语句，如果学号不同，就在两者之间插入一个空白行，然后再在每个空白行粘贴复制的表头，最后使用循环语句，自动制作每个学生成绩记录的表头。
解决问题的方法
打开学生的成绩表，我们需要另存为另外一个表来制作成绩条，以免影响成绩表的原貌。
在VBA的工程资源管理器中双击Sheet1，然后出现代码窗口，在代码窗口输入如下代码：
Sub cjt()
Application.ScreenUpdating = False
Sheets(1).[A1].CurrentRegion.Copy Sheets(2).[A1]
’将表一的成绩表复制到表二
a=(Application.WorksheetFunction.CountA(Sheets(2).[b2:b2000]))*2
’sheets(1).[b2:b2000]的字符数的2倍
Sheets(2).[A1:R1].Borders(xlEdgeTop).LineStyle = xlDouble
’sheets(2).[a1:r1]的下边框是双线
For i = 2 To a
If Sheets(2).Cells(i, 3) <> Sheets(2).Cells(i + 1, 3) And (Sheets(2).Cells(i, 3) <> "") Then
Sheets(2).Rows(i + 1).Insert
End If
’如果第三列的上下单元格的值不相等，则在它们之间插入一个空白行
If Sheets(2).Cells(i, 3) = "" Then
Sheets(2).[A1:R1].Copy Sheets(2).Cells(i, 1)
End If
’如果第三列中的单元格是空的，则将Sheets(2).[A1:R1]复制到此行
Next
Application.ScreenUpdating = True
End Sub
(责任编辑：admin)
顶一下
(0)
0%
踩一下
(0)
0%
最新内容
推荐内容