Excel VBA合并一列中的同类项

合并一列中内容相同单元格

Sub MergeRange()
Dim Rng As Range
Dim i&, Col&, Fist, Last
Set Rng = Application.InputBox("请选择单列数据列！", Type:=8)
Set Rng = Intersect(Rng.Parent.UsedRange, Rng)
Col = Rng.Column
Fist = Rng.Row
Last = Fist + Rng.Rows.Count - 1
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Rng.Parent.Select
For i = Last To Fist + 1 Step -1
If Cells(i, Col) = Cells(i - 1, Col) Then
Cells(i - 1, Col).Resize(2, 1).Merge
End If
Next
Rng.VerticalAlignment = xlCenter
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "合并完成。"
End Sub

完成一列后，可使用格式刷对其他列进行合并。