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

共有 0 条评论