Excel中多行合并
从来就么写过博客，突然想写一篇，来天天我空空窝……
不幸被抽中去教务处工作，整天的整理着学生的各科成绩。学业水平测试成绩下来了，打开一看傻眼了……
以图说明：
很是恼火，几千人的考试，而每个人有好几次的考试，每一次都有不同的成绩，难过与无奈……
有没有什么办法能够自动合并？网上搜索…… 找到很多没有我想要的……
那就自己来，毛主席的话“自己动手丰衣足食！” 说干就干，百度搜索“宏教程”，找到关于excel宏方面的资料。阅读：编写程序！
Sub yx()
Dim i, j As Integer '定义两个循环变量
Dim a1, a2 As String '定义两个用于存放单元格字符串的变量
j = 0 '初始化
For i = 1 To 3072 '从第一个单元格到最后一个单元格
j = i + 1
a1 = ActiveSheet.Cells(i, 1) '得到一个单元格的值
a2 = ActiveSheet.Cells(j, 1) '得到后面的一个单元的值
If (a1 Like a2) Then '如果两个单元格的值相同，说明要合并，否则就是
'下一个人的，不用合并。下面的是合并的过程
ActiveSheet.Cells(i, 2) = ActiveSheet.Cells(i, 2) & ActiveSheet.Cells(j, 2)
ActiveSheet.Cells(i, 3) = ActiveSheet.Cells(i, 3) & ActiveSheet.Cells(j, 3)
ActiveSheet.Cells(i, 4) = ActiveSheet.Cells(i, 4) & ActiveSheet.Cells(j, 4)
ActiveSheet.Cells(i, 5) = ActiveSheet.Cells(i, 5) & ActiveSheet.Cells(j, 5)
ActiveSheet.Cells(i, 6) = ActiveSheet.Cells(i, 6) & ActiveSheet.Cells(j, 6)
ActiveSheet.Cells(i, 7) = ActiveSheet.Cells(i, 7) & ActiveSheet.Cells(j, 7)
ActiveSheet.Cells(i, 8) = ActiveSheet.Cells(i, 8) & ActiveSheet.Cells(j, 8)
ActiveSheet.Cells(i, 9) = ActiveSheet.Cells(i, 9) & ActiveSheet.Cells(j, 9)
ActiveSheet.Cells(i, 10) = ActiveSheet.Cells(i, 10) & ActiveSheet.Cells(j, 10)
ActiveSheet.Cells(i, 11) = ActiveSheet.Cells(i, 11) & ActiveSheet.Cells(j, 11)
ActiveSheet.Cells(i, 12) = ActiveSheet.Cells(i, 12) & ActiveSheet.Cells(j, 12)
ActiveSheet.Cells(i, 13) = ActiveSheet.Cells(i, 13) & ActiveSheet.Cells(j, 13)
Rows(j).Delete '合并以后就要删除这一行
j = 0 '完成下一次的初始化
End If
Next i
End Sub
经过两次执行，已经完成了合并，结果如图：
运行了两次已经差不多了，为了防止有人考了4次或5次，我有运行了两遍，最后查找替换就行了。到此 打完……收工……
备注：还可进行一个小小的改进，就是一次完成那个所有的合并，只要在循环里在进行一个小的嵌套就行了。