EXCEL快速合并相同值

Option Explicit Private srow As Integer Sub T() Application.ScreenUpdating = False Application.DisplayAlerts = False Dim i As Integer, lcol As Integer srow = Application.InputBox("输入处理起始行号") lcol = Range("IV" & srow).End(xlToLeft).Column For i = 1 To lcol Call tt(i) Next Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub

Function tt(ByVal i As Integer) Dim lrow As Long, s As String, j As Integer, p As Integer, q As Integer j = srow lrow = Cells(65536, i).End(xlUp).Row While j < lrow s = Cells(j, i) p = j While Cells(j + 1, i) = s j = j + 1 Wend q = j If p <> q Then With Range(Cells(p, i), Cells(q, i)) .Merge '.HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter End With End If j = q + 1 Wend End Function