Sub SpecialMerge()
Dim M As Long, N As Long
Dim i As Long, j As Long
Dim k1 As Long, k2 As Long
Application.DisplayAlerts = False
k1 = 1
k2 = 1
With Selection
M = .Columns.Count
N = .Rows.Count
For j = 1 To M
For i = 1 To N
If .Cells(i, j) = "" Then
k2 = i
Else
Range(.Cells(k1, j), .Cells(k2, j)).Merge
k1 = i
k2 = i
End If
Next i
Range(.Cells(k1, j), .Cells(k2, j)).Merge
k1 = 1
k2 = 1
Next j
End With
Application.DisplayAlerts = True
End Sub
操作方法:选中要操作的数据区域,运行宏即可。见示例文件。
Sub 合并单元格()
Application.DisplayAlerts = False
k = ActiveSheet.UsedRange.Rows.Count
For j = 1 To 2
For i = k To 1 Step -1
If Cells(i, j) = "" Then Range(Cells(i - 1, j), Cells(i, j)).Merge
Next
Next
Application.DisplayAlerts = True
End Sub