需要一个数据处理的宏

柳生十兵卫

    需要一个处理数据的宏， 见附件  sheet1是原数据   sheet2是我需要输出的结果
以第二行为列
条件是先判断 J   K  两列  如果不是空的  就在第二后面插入一行 把J K 的值复制到G H列
然后是判断M N 列    如果不空  就再插入一行   把值复制到G H
然后在判断P Q   同上
然后在判断R S  同上
可能说的不是很明白    可以看一下附件   sheet2 第二行的列子

因为行数 一直在变  只有一行我还能写写  
但是数据多了就蒙了
希望有高手指点一下   或者帮帮我写写
感谢

zhenghui13

有点看不明白，是否是J列开始，每两列循环，并将值复制到H和I列

柳生十兵卫

zhenghui13 发表于 2018-7-19 16:50
有点看不明白，是否是J列开始，每两列循环，并将值复制到H和I列

对  J列开始  两列一判断  值是复制到G列和H列    插入行在复制

zhenghui13

不知道是否是你要的效果，请查看。

1. 
   
2. Sub Main()
   
3. Dim t
   
4. Dim arr, i1, j1, k1
   
5. Dim brr, i2, j2, k2
   
6. t = Timer
   
7. arr = Sheet1.UsedRange
   
8. ReDim brr(1 To 100, 1 To 9)
   
9. For i1 = 2 To UBound(arr, 1)
   
10.     i2 = i2 + 1
    
11.     For j1 = 1 To 9
    
12.         j2 = j1
    
13.         brr(i2, j2) = arr(i1, j1)
    
14.     Next j1
    
15.     For k1 = 10 To UBound(arr, 2) Step 2
    
16. '       If k1 Mod 2 = 1 Then k2 = 7 Else k2 = 8   '总是成对出现
    
17.         k2 = 7
    
18.         If arr(i1, k1) <> "" Or arr(i1, k1 + 1) <> "" Then
    
19.             i2 = i2 + 1
    
20.             brr(i2, k2) = arr(i1, k1)
    
21.             brr(i2, k2 + 1) = arr(i1, k1 + 1)
    
22.         End If
    
23.     Next k1
    
24. Next i1
    
25. With Sheet3
    
26.     .[A2].Resize(i2, 9) = brr
    
27.     .Select
    
28. End With
    
29. Debug.Print Timer - t
    
30. End Sub
    

复制代码

柳生十兵卫

zhenghui13 发表于 2018-7-19 17:37
不知道是否是你要的效果，请查看。

运行到后面会报错  object required     前几行运行了好像没什么变化
   

柳生十兵卫

zhenghui13 发表于 2018-7-19 17:37
不知道是否是你要的效果，请查看。

请问如何能更方便联系你

zhenghui13

柳生十兵卫 发表于 2018-7-20 10:38
请问如何能更方便联系你

wechat:zheng13918545664