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
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 条评论