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

fangniuji

hwc2ycy 发表于 2012-11-24 19:25
没数据时是没有增加嘛，你看看。

没数据以ok,有数据时也不能增加，谢谢！！！太谢谢啦！！！，再帮我改一下，谢谢！！！

hwc2ycy

你还可以试试行列数据不对称的情况。

hwc2ycy

我好奇，你这表里的数据，都底是用在啥场合啊。

fangniuji

hwc2ycy 发表于 2012-11-24 19:31
我好奇，你这表里的数据，都底是用在啥场合啊。

电路板上资料，有资料时空格帮我删除，谢谢！！！！

hwc2ycy

是数据列里的空格不添加进去？
还是添加的资料下面不要有2行空行？

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)) > 0 Then K = K + 1: arr1(K, 1) = arr(i, 1)
    
14.             If Len(arr(i, 2)) > 0 Then K = K + 1: arr1(K, 1) = arr(i, 2)
    
15.         ElseIf arr(i, 1) = arr(i - 1, 1) Then
    
16.             K = K + 1
    
17.             arr1(K, 1) = arr(i, 2)
    
18.         Else
    
19.             If Len(arr(i, 1)) > 0 Then K = K + 1: arr1(K, 1) = arr(i, 1)
    
20.             If Len(arr(i, 2)) > 0 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 + 2).Insert Shift:=xlDown
    
26.     Range("A" & iRow).Resize(K + 2) = arr1
    
27.     Application.ScreenUpdating = True
    
28.     Application.Calculation = xlAutomatic
    
29. End Sub

复制代码

fangniuji

hwc2ycy 发表于 2012-11-24 19:51

有数据时，还多两个空格！！！再看看，谢谢。。

hwc2ycy

我不懂了，你这空格空行，一直就M30上加了2行空行嘛。然后上面的代码不过是把空白单元格给过滤了。你上效果图吧。

fangniuji

hwc2ycy 发表于 2012-11-24 20:35
我不懂了，你这空格空行，一直就M30上加了2行空行嘛。然后上面的代码不过是把空白单元格给过滤了。你上效果 ...

添加的资料下面不要有2行空行 就M30以上两个，帮我删除，谢谢！！！

hwc2ycy

    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