EXCEL用VBA实现单元格的自动合并和拆分
Stanley
Excel中分级显示功能不强。

最常用的方法是把高层的单元格合并。

但这样往往导致排序、筛选等“数据”功能不能使用，这时又要拆分；然后再合并。

拆分。

这里提供了我自己用的、用VBA实现的、单元格自动合并和拆分的程序。

使用时请作为宏来执行。

希望对大家有用。

Sub MergeActiveWorkbookActiveSheetVertically()
Dim m, n, t, col As Long
Application.DisplayAlerts = False
For col = 1 To 100 'set firest and last column that can be merged
m = 2 ' compare from row 2, row 1 must be title of the table!
For n = 3 To Cells(Rows.Count, col).End(3).Row + 1
If Cells(n, col).Value <> Cells(n - 1, col).Value And m < n Then 'find the first different value under current cell
With Range(Cells(m, col), Cells(n - 1, col))
.Merge
.HorizontalAlignment = xlLeft 'Center
.VerticalAlignment = xlCenter
End With
m = n
End If
If Cells(n, col).Value = "" Then
m = n + 1
End If
Next n
Next col
Application.DisplayAlerts = True
End Sub
Private Sub UnMergeActiveWorkbookActiveSheet()
Dim i As Range
Dim v As Variant
Dim k, j As Integer
For Each i In edRange 'must give the ActiveWorkbook!
If i.Address <> i.MergeArea.Address And i.Address = i.MergeArea.Item(1).Address Then v = i.Value
i.MergeArea.Select
i.MergeArea.UnMerge
For j = Selection.Row To Selection.Row + Selection.Rows.Count - 1 'fill the rect area!
For k = Selection.Column To Selection.Column + Selection.Columns.Count - 1
ActiveWorkbook.ActiveSheet.Cells(j, k) = v
Next k
Next j
End If
Next i
Cells(1, 1).Select
End Sub
（最初的程序来自网上，但原来的有不少问题，这个是修改过经过测试的）。