[已解决]求大神改善关于复制的代码

lingyuncelia1

Sub celia()
For i = 1 To 3
For j = 3 To 8
For n = 1 To 18
Cells(i, j) = Cells(n, 1)
Next
Next
Next
End Sub

我知道以上代码无效，求如何改善以上代码有以下效果？

最佳答案

月排行榜 / 总排行榜

gufengaoyue

2016-8-16 12:10

1. Sub xxx()
   
2. Dim i%, j%, n%
   
3. For i = 1 To 3
   
4.     For j = 3 To 8
   
5.         n = n + 1
   
6.         Cells(i, j) = Cells(n,1)
   
7.     Next
   
8. Next
   
9. End Sub
   

复制代码

跳转到最佳答案楼层

gufengaoyue

1. Sub xxx()
   
2. Dim i%, j%, n%
   
3. For i = 1 To 3
   
4.     For j = 3 To 8
   
5.         n = n + 1
   
6.         Cells(i, j) = Cells(n,1)
   
7.     Next
   
8. Next
   
9. End Sub
   

复制代码

望帝春心

1. Sub test()
   
2.     Dim i%, j%, k%
   
3.     Dim arr(1 To 3, 1 To 6)
   
4.     For i = 1 To 3
   
5.         For j = 1 To 6
   
6.             k = k + 1
   
7.             arr(i, j) = Cells(k, 1)
   
8.         Next j
   
9.     Next i
   
10.     [c1].Resize(3, 6) = arr
    
11. End Sub

复制代码

lingyuncelia1

Sub 竖变横复制()
n = 1
For i = 1 To 3
For j = 1 To 6
Sheet2.Cells(i, j) = Sheet1.Cells(n, 1)
n = n + 1
Next
Next
End Sub