Sub mergeunit()
Dim spos, epos As Integer
Dim ustr, nowstr As String
spos = 1
epos = 1
ustr = Cells(1, 1)
Application.DisplayAlerts = False
Do
nowstr = Cells(epos, 1)
If nowstr <> ustr Then
Range("A" & spos & ":A" & epos - 1).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
ustr = nowstr
End With
Selection.Merge
spos = epos
End If
epos = epos + 1
Loop While Len(nowstr) > 0
End Sub