[已解决]请教下如何批量指定数量进行复制粘贴?

sbjjpl

请教下各位老师，如何批量指定数量进行复制粘贴到表2中，并且每行按四列排列，谢谢！

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2017-10-17 14:16

1. Sub aaa()
   
2. Dim arr, brr, i&, j&, r&, c&
   
3. arr = Sheets(1).[a1].CurrentRegion
   
4. ReDim brr(1 To -Int(-Application.Sum(arr) / 4), 1 To 4)
   
5. r = 1
   
6. For i = 2 To UBound(arr)
   
7.   For j = 1 To arr(i, 2)
   
8.     c = c + 1
   
9.     If c = 5 Then c = 1: r = r + 1
   
10.     brr(r, c) = arr(i, 1)
    
11.   Next j
    
12. Next i
    
13. Sheets(2).[a1].Resize(r, 4) = brr
    
14. End Sub

复制代码

跳转到最佳答案楼层

大灰狼1976

1. Sub aaa()
   
2. Dim arr, brr, i&, j&, r&, c&
   
3. arr = Sheets(1).[a1].CurrentRegion
   
4. ReDim brr(1 To -Int(-Application.Sum(arr) / 4), 1 To 4)
   
5. r = 1
   
6. For i = 2 To UBound(arr)
   
7.   For j = 1 To arr(i, 2)
   
8.     c = c + 1
   
9.     If c = 5 Then c = 1: r = r + 1
   
10.     brr(r, c) = arr(i, 1)
    
11.   Next j
    
12. Next i
    
13. Sheets(2).[a1].Resize(r, 4) = brr
    
14. End Sub

复制代码

sbjjpl

大灰狼1976 发表于 2017-10-17 14:16

谢谢，完全达到我的要求，前段时间不在，一直没回复