[已解决]这代码改改，谢谢！！1

fangniuji

hwc2ycy 发表于 2012-11-24 20:44
Range("A" & iRow).Resize(K + 2).Insert Shift:=xlDown
    Range("A" & iRow).Resize(K + 2) = arr1 ...

我运行时，有点小问题。不好意思再帮我改改帮我改改，谢谢！！！！

hwc2ycy

T,U列下面的非假空格啊

hwc2ycy

1. Sub Test555()
   
2.     Dim iRow, x, arr1(1 To 165536, 1 To 1), i, K
   
3.     Dim TRow&, URow&
   
4.     iRow = Range("A:A").Find(what:="M30").Row
   
5.     x = Range("T:T").Find("", LookIn:=xlValues).Row - 1
   
6.     TRow = Range("t" & Rows.Count).End(xlUp).Row
   
7.     URow = Range("u" & Rows.Count).End(xlUp).Row
   
8.     If TRow = 1 And URow = 1 Then MsgBox "没有增加数据": Exit Sub
   
9.     x = IIf(TRow > URow, TRow, URow)
   
10.     arr = Range("T2:U" & x)
    
11.     For i = 1 To UBound(arr)
    
12.         If i = 1 Then
    
13.             If Len(arr(i, 1)) Then K = K + 1: arr1(K, 1) = arr(i, 1)
    
14.             If Len(arr(i, 2)) Then K = K + 1: arr1(K, 1) = arr(i, 2)
    
15.         ElseIf arr(i, 1) = arr(i - 1, 1) Then
    
16.             
    
17.             If Len(arr(i, 2)) Then K = K + 1: arr1(K, 1) = arr(i, 2)
    
18.         Else
    
19.             If Len(arr(i, 1)) Then K = K + 1: arr1(K, 1) = arr(i, 1)
    
20.             If Len(arr(i, 2)) Then K = K + 1: arr1(K, 1) = arr(i, 2)
    
21.         End If
    
22.     Next
    
23.     Application.ScreenUpdating = False
    
24.     Application.Calculation = xlManual
    
25.     Range("A" & iRow).Resize(K).Insert Shift:=xlDown
    
26.     Range("A" & iRow).Resize(K) = arr1
    
27.     Application.ScreenUpdating = True
    
28.     Application.Calculation = xlAutomatic
    
29. End Sub

复制代码

fangniuji

hwc2ycy 发表于 2012-11-24 23:36

OK啦，谢谢！！！！！！！！！！！！！！！！！！！！！