Sub MergeSameCells()
    Dim lRow As Integer
    Application.DisplayAlerts = False
    With ActiveSheet
        lRow = .Range("A65536").End(xlUp).Row   '获得A列最后一个有数据的行
        For i = lRow To 2 Step -1
            If .Cells(i, 1).Value = .Cells(i - 1, 1).Value Then
                .Range(.Cells(i - 1, 1), .Cells(i, 1)).Merge
            End If
        Next
    End With
    Application.DisplayAlerts = True
End Sub