EXCEL用VBA实现单元格的自动合并和拆分

Stanley

用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 ActiveWorkbook.ActiveSheet.UsedRange '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

（最初的程序来自网上，但原来的有不少问题，这个是修改过经过测试的）