[已解决]请教高手

jx1680000

放在第一列，再放回去

zjcat35

1. Sub a()
   
2.     Dim i As Integer, j As Integer, k As Integer
   
3.     Columns("I:I").Copy
   
4.     Range("i1").PasteSpecial Paste:=xlPasteValues
   
5.     For i = [a65536].End(3).Row To 2 Step -1
   
6.         j = Cells(i, 1).End(xlToRight).Column / 2 - 2
   
7.         If j > 0 Then
   
8.             Rows(i + 1).Resize(j).Insert
   
9.             For k = 1 To j
   
10.                 Cells(i, 4 + 2 * k - 1).Resize(1, 2).Copy Range("c1").End(xlDown).Offset(1, 0).Resize(1, 2)
    
11.             Next k
    
12.         End If
    
13.     Next i
    
14.     Range("e:h").Delete
    
15. End Sub

复制代码

ztccsj

zjcat35 发表于 2012-2-22 15:01

真是研究生水平啊，学习了