如果T2和u2以下,没数据,我点一下按钮,会增加新编号 排列 及两行空格,大家帮忙改一下代码,没数据时,不增加新编号 排列 及两行空格,并提示没增加数据,谢谢!!!
Sub Test555()
Dim iRow, x, arr1(1 To 165536, 1 To 1), i, K
iRow = Range("A:A").Find(what:="M30").Row
x = Range("T:T").Find("", LookIn:=xlValues).Row - 1
Arr = Range("T2:U" & x)
For i = 1 To UBound(Arr)
If i = 1 Then
K = K + 1
arr1(K, 1) = Arr(1, 1)
K = K + 1
arr1(K, 1) = Arr(1, 2)
ElseIf Arr(i, 1) = Arr(i - 1, 1) Then
K = K + 1
arr1(K, 1) = Arr(i, 2)
Else
K = K + 1
arr1(K, 1) = Arr(i, 1)
K = K + 1
arr1(K, 1) = Arr(i, 2)
End If
Next
Application.ScreenUpdating = False
Application.Calculation = xlManual
Range("A" & iRow).Resize(K).Insert Shift:=xlDown
Range("A" & iRow).Resize(K) = arr1
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub
Range("A" & iRow).Resize(K + 2).Insert Shift:=xlDown
Range("A" & iRow).Resize(K + 2) = arr1
改为
Range("A" & iRow).Resize(K ).Insert Shift:=xlDown
Range("A" & iRow).Resize(K) = arr1
|