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
转载请注明：积木居 » EXCEL快速合并相同值
