[已解决]vba 拆分并在a列添加数量序号

qhllqhll

求各位老师帮助解决：见附件 附件.rar (7.15 KB, 下载次数: 10)

2013-8-8 20:37 上传

点击文件名下载附件
要求：
i列的“数量”是几，就复制几行，并且在对应的a列编写从（01---0几）“序号”
例如：[i4]=5 则（ 见“商品拆分”表里）复制本表[b4：h4] 五行,
例如：[i6]=3 则（ 见“商品拆分”表里）复制本表[b6：h6] 三行,
一直到本表d列的最后一个不为空的行
效果 见“商品拆分”表里的效果

最佳答案

月排行榜 / 总排行榜

L50814026

2013-8-8 21:42

附件.rar (20.52 KB, 下载次数: 14)

2013-8-8 21:42 上传

点击文件名下载附件
有点慢

跳转到最佳答案楼层

windimi007

不喜欢复制粘贴，没有填充色没关系吧！请测试！{:1712:}

1. Sub test()
   
2.     Dim ar, br(1 To 100000, 1 To 9)
   
3.     Dim i As Long, j As Long, k As Long, l As Long
   
4.     ar = Sheet2.Range("A4:I" & Sheet2.Cells(Rows.Count, 4).End(3).Row)
   
5.     For i = 1 To UBound(ar)
   
6.         For j = 1 To ar(i, 9)
   
7.             k = k + 1
   
8.             br(k, 1) = "'" & Format(k, "00")
   
9.             For l = 2 To 9
   
10.                 br(k, l) = ar(i, l)
    
11.             Next l
    
12.         Next j
    
13.     Next i
    
14.     With Sheet1.Cells(4, 1)
    
15.         .Resize(Rows.Count - 3, 9).Clear
    
16.         With .Resize(k, 9)
    
17.             .Value = br
    
18.             .Borders.LineStyle = xlContinuous
    
19.             .Cells.EntireColumn.AutoFit
    
20.         End With
    
21.     End With
    
22. End Sub

复制代码

L50814026

附件.rar (20.52 KB, 下载次数: 14)

2013-8-8 21:42 上传

点击文件名下载附件
有点慢