­ã´£³¡ªL

¦³ÂI¶, ¸Õ¸Õ~~

Sub Test2()
Dim R&, xR As Range, xH As Range, xE As Range, T1$, T2$, N&
Application.ScreenUpdating = False
With [A:A]: .UnMerge: .ClearContents: .HorizontalAlignment = 3: End With
R = [B65536].End(xlUp).Row
For Each xR In Range("B5:B" & R)
    If xR.Interior.ColorIndex = 24 Then N = 0:  GoTo 101
    T1 = Left(xR, 11): If T1 = "" Then GoTo 101
    If T2 <> "" And T1 <> T2 Then Range(xH, xE).Merge: T2 = ""
    If T1 <> T2 Then Set xH = xR(1, 0): N = N + 1: xH = N:  T2 = T1
    If T1 = T2 Then Set xE = xR(1, 0)
    If xR.Row = R Then Range(xH, xE).Merge
101: Next
Range([A5], xE).Borders.LineStyle = 1
End Sub


=============================