这个怎么写成for循环 下面还有很多都是有规律的重复动作 可以写成循环吗？

709397578

1. <p>Sub 宏2()
   
2. '
   
3. ' 宏2 宏
   
4. '</p><p>'
   
5.     Range("A2:D8").Select
   
6.     Selection.Copy
   
7.     Range("G2").Select
   
8.     Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
   
9.         False, Transpose:=True
   
10.     Range("A9:D15").Select
    
11.     Application.CutCopyMode = False
    
12.     Selection.Copy
    
13.     Range("G9").Select
    
14.     Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    
15.         False, Transpose:=True
    
16.     Range("A16:D22").Select
    
17.     Application.CutCopyMode = False
    
18.     Selection.Copy
    
19.     Range("G16").Select
    
20.     Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    
21.         False, Transpose:=True
    
22.     Range("A23:D29").Select
    
23.     Application.CutCopyMode = False
    
24.     Selection.Copy
    
25.     Range("G23").Select
    
26.     Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    
27.         False, Transpose:=True
    
28. End Sub
    
29. </p>
    
30. <p> </p>

复制代码

清风竹-

1. <div class="blockcode"><blockquote>
   

复制代码

Sub 宏2()

m = [a65536].End(3).Row + 7

arr = Range("A2:D" & m)

s = UBound(arr)

ReDim brr(1 To s, 1 To 7)

For i = 1 To s Step 7

    If arr(i, 1) = "" Then Exit For

    For j = 0 To 6

         For k = 0 To 3

             brr(i + k, j + 1) = arr(i + j, k + 1)

          Next

    Next

Next

  [g2].Resize(s, 7) = brr

End Sub

709397578

清风竹- 发表于 2016-7-10 10:39

谢谢  不过 提示下标越界

709397578

清风竹- 发表于 2016-7-10 10:39

是要把对应的列 变成行

清风竹-

709397578 发表于 2016-7-10 10:53
是要把对应的列 变成行

1. <div class="blockcode"><blockquote>Sub 宏2()
   
2. m = [a65536].End(3).Row + 7
   
3. arr = Range("A2:D" & m)
   
4. s = UBound(arr)
   
5. ReDim brr(1 To s, 1 To 7)
   
6. For i = 1 To s Step 7
   
7.     If arr(i, 1) = "" Then Exit For
   
8.     For j = 0 To 6
   
9.          For k = 0 To 3
   
10.              brr(i + k, j + 1) = arr(i + j, k + 1)
    
11.           Next
    
12.     Next
    
13. Next
    
14.   [g2].Resize(s, 7) = brr
    
15. End Sub
    

复制代码

709397578

清风竹- 发表于 2016-7-10 11:10

谢谢  非常感谢  可以啦

709397578

清风竹- 发表于 2016-7-10 11:10

不好意思啊  还有个问题  怎么取消掉我画圈的里面的空行啊   谢谢您了

清风竹-

709397578 发表于 2016-7-11 11:29
不好意思啊  还有个问题  怎么取消掉我画圈的里面的空行啊   谢谢您了

1. Sub 宏2()
   
2. m = [a65536].End(3).Row + 7
   
3. arr = Range("A2:D" & m)
   
4. s = UBound(arr)
   
5. ReDim brr(1 To s, 1 To 7)
   
6. For i = 1 To s Step 7
   
7.     If arr(i, 1) = "" Then Exit For
   
8.     For j = 0 To 6
   
9.          For k = 0 To 3
   
10.              brr(i / 7 * 4 + k, j + 1) = arr(i + j, k + 1)
    
11.           Next
    
12.     Next
    
13. Next
    
14.   [g2].Resize(s, 7) = brr
    
15. End Sub
    

复制代码

709397578

清风竹- 发表于 2016-7-11 18:12

太谢谢啦