如下代码:
Sub xxx()
r = 2: d = Cells(Rows.Count, "d").End(xlUp).Row
Do While r < d
Application.DisplayAlerts = False
n = Cells(r, "d").End(xlDown): r1 = Cells(r, "d").End(xlDown).Row
Range(Cells(r, "d"), Cells(r1, "d")).Merge: Cells(r, "d") = n
r = r1 + 1
Loop
End Sub
