VBA实例02：批量合并单元格

Sub MergeRange()

Dim rngData As Range
Dim i, lngCol, lngFirst, lngLast
'On Error Resume Next

Set rngData = Application.InputBox("请选择单列数据列！", Default:=Selection.Address, Type:=8)

Set rngData = Intersect(rngData.Parent.UsedRange, rngData) 'intersect语句避免用户选择整列造成低效运算

lngCol = rngData.Column 'rngData所在列
lngFirst = rngData.Row '用户选择的区域并不是一定从第一行开始，使用此句读取开始行

lngLast = lngFirst + rngData.Rows.Count - 1 'rngData结束行

Application.ScreenUpdating = False '取消屏幕刷新
Application.DisplayAlerts = False '取消消息提醒。
rngData.Parent.Select '激活rngData对象所在的工作表，避免跨工作表操作问题
 For i = lngLast To lngFirst + 1 Step -1 '对rngData进行从尾向前遍历
    If Cells(i, lngCol) = Cells(i - 1, lngCol) Then
        Cells(i - 1, lngCol).Resize(2, 1).Merge
    End If
 Next

rngData.VerticalAlignment = xlCenter '单元格格式上下居中
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "合并完成！"
End Sub