1 Sub 太复杂不过也行()
 2 num = Application.CountA([a:a])
 3 For i = 2 To num
 4     If Cells(i, 1) = Cells(i + 1, 1) Then
 5     n = n + 1
 6     Else
 7     Range(Cells(i - n, 1), Cells(i, 1)).Merge
 8     n = 0
 9     End If
10     Next
11 End Sub

 1 Sub 改进版()
 2 Application.DisplayAlerts = False‘去除合并时系统的提醒
 3 num = Application.CountA([a:a])
 4 Dim rng As Range
 5 For i = num To 2 Step -1
 6 ‘为什么不用正序？用了后就会发现正序合并不完全，因为这里的思路是依次合并
 7 ‘而合并后的区域真正有Value的是该区域最左上的单元格位置
 8 ‘因此正序情况下只会合并两个单元格
 9 ‘第三个单元格因为判断第二个单元格Value为空而不进行合并
10 ‘同理接下来的也就不能合并了
11     Set rng = Cells(i, "i")
12     If rng = rng.Offset(-1) Then
13     rng.Offset(-1).Resize(2).Merge
14     End If
15     Next
16     Application.DisplayAlerts = True‘开启合并时系统的提醒
17 End Sub

1 Sub 解除合并单元格后保持原来的数据()
2 Dim b%, rng As Range
3     For Each rng In Selection
4         b = rng.MergeArea.Count ‘合并的单元格数量
5         rng.UnMerge
6         rng.Resize(b) = rng ‘这里Resize用的巧妙
7     Next
8 End Sub