用Excel制作学生成绩条

现在很多学校都在使用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