代码如下: Sub MergeRange() 'EH技术论坛:VBA编程学习与实践 看见星光 Dim Rng As Range Dim i&, Col&, Fist, Last Application.ScreenUpdating = False '取消屏幕更新 Application.DisplayAlerts = False '取消信息提醒。当有值单元格被合并时屏蔽提示信息 Set Rng = Application.InputBox('请选择单列数据列!', Type:=8) '用户选择数据列 Set Rng = Intersect(Rng.Parent.UsedRange, Rng) 'intersect语句避免用户选择整列造成无谓运算 Col = Rng.Column 'Rng所在列 Fist = Rng.Row 'Rng开始行,用户选择的区域并不是一定从第一行开始,因此需要此句判断 Last = Fist Rng.Rows.Count - 1 'Rng结束行 Rng.Parent.Select '激活Rng对象所在的工作表 For i = Last To Fist 1 Step -1 '对Rng进行从后向前遍历 If Cells(i, Col) = Cells(i - 1, Col) Then Cells(i - 1, Col).Resize(2, 1).Merge End If Next Rng.VerticalAlignment = xlCenter '格式上下居中 MsgBox '合并完成。' Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub |
|
来自: L罗乐 > 《VBA常用小代码》