[已解决]插入多行并复制上行数据？

66327823

俺学校要将资产数量大于2的项目拆开，请各位大神给个代码吧。

最佳答案

月排行榜 / 总排行榜

芐雨

2014-6-5 11:14

不是回你了吗，别重复发贴。
拆解表.zip (48.13 KB, 下载次数: 14)

2014-6-5 11:14 上传

点击文件名下载附件

1. Sub 根据列值插入空行_芐雨()
   
2.     Dim arr, maxRow&, i&, j&, x&, brr(1 To 100000, 1 To 12)
   
3.     maxRow = Cells(Rows.Count, 1).End(3).Row
   
4.     arr = Range("A1:L" & maxRow)  '区域，可自行修改
   
5.     For i = 2 To UBound(arr)
   
6.         x = x + 1
   
7.         For k = 1 To 12
   
8.             brr(x, k) = arr(i, k)
   
9.         Next
   
10.         If arr(i, 8) > 1 Then     '数量大于1
    
11.             For j = 1 To arr(i, 8)
    
12.                 x = x + 1
    
13.                 For k = 1 To 12
    
14.                     brr(x, k) = arr(i, k)
    
15.                 Next
    
16.                 brr(x, 8) = 1
    
17.                 brr(x, 11) = arr(i, 11) / arr(i, 8)
    
18.             Next
    
19.         End If
    
20.     Next
    
21.     Range("A2").Resize(x, 12) = brr    '输出数组
    
22. End Sub
    

复制代码

跳转到最佳答案楼层

芐雨

不是回你了吗，别重复发贴。
拆解表.zip (48.13 KB, 下载次数: 14)

2014-6-5 11:14 上传

点击文件名下载附件

1. Sub 根据列值插入空行_芐雨()
   
2.     Dim arr, maxRow&, i&, j&, x&, brr(1 To 100000, 1 To 12)
   
3.     maxRow = Cells(Rows.Count, 1).End(3).Row
   
4.     arr = Range("A1:L" & maxRow)  '区域，可自行修改
   
5.     For i = 2 To UBound(arr)
   
6.         x = x + 1
   
7.         For k = 1 To 12
   
8.             brr(x, k) = arr(i, k)
   
9.         Next
   
10.         If arr(i, 8) > 1 Then     '数量大于1
    
11.             For j = 1 To arr(i, 8)
    
12.                 x = x + 1
    
13.                 For k = 1 To 12
    
14.                     brr(x, k) = arr(i, k)
    
15.                 Next
    
16.                 brr(x, 8) = 1
    
17.                 brr(x, 11) = arr(i, 11) / arr(i, 8)
    
18.             Next
    
19.         End If
    
20.     Next
    
21.     Range("A2").Resize(x, 12) = brr    '输出数组
    
22. End Sub
    

复制代码

66327823

芐雨 发表于 2014-6-5 11:14
不是回你了吗，别重复发贴。

谢谢您，原来可能没有说明白，现在又传了个附件。谢谢您的解答。