用merge合并单元格

 

Option Explicit

Sub mer()
    Application.DisplayAlerts = False
    Dim str1 As String, str2 As String, i As Long
    Dim a As Range
    
    For i = Cells(Rows.Count, "B").End(xlUp).Row To 2 Step -1
        str1 = Cells(i, 2).Value
        str2 = Cells(i - 1, 2).Value
        Range(Cells(i, 2), Cells(i - 1, 2)).Select
        If str1 = str2 Then
            Selection.Merge
        End If
        
    Next i
    Application.DisplayAlerts = True

End Sub

结果图