把“原表”中5列多行的区域,按10行5列的区域,并排生成4个区域格式向下填充,谢谢!

lihaosh

工作簿1.rar (24.25 KB, 下载次数: 12)

2022-12-11 01:50 上传

点击文件名下载附件

fzxba

1. Sub test1()
   
2.   Dim i As Long, j As Long, r As Long, c As Long
   
3.   Dim Sht As Worksheet
   
4.   r = 1
   
5.   c = 1
   
6.   Set Sht = Worksheets("结果")
   
7.   Sht.Cells.Clear
   
8.   With Worksheets("原表")
   
9.     For i = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row Step 10
   
10.       .Cells(i, 1).Resize(10, 5).Copy Sht.Cells(r, c)
    
11.       c = c + 6
    
12.       j = j + 1
    
13.       If (j Mod 4) = 0 Then c = 1: r = r + 11
    
14.     Next
    
15.   End With
    
16.   Set Sht = Nothing
    
17. End Sub

复制代码

蓝桥玄霜

排列的例子：

chxw68

1. Sub test()
   
2.     Dim r%, i%, m%, n%
   
3.     With Worksheets("结果")
   
4.         .Cells.Clear
   
5.     End With
   
6.     With Worksheets("原表")
   
7.         r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
8.         m = 1
   
9.         n = 1
   
10.         For i = 1 To r Step 10
    
11.             .Cells(i, 1).Resize(10, 5).Copy Worksheets("结果").Cells(m, n)
    
12.             n = n + 6
    
13.             If n > 19 Then
    
14.                 m = m + 11
    
15.                 n = 1
    
16.             End If
    
17.         Next
    
18.     End With
    
19. End Sub
    

复制代码

chxw68

数据不多的话，直接拷贝代码简单。

lihaosh

感谢楼上老师，牛！！！

准提部林

Sub TEST_A1()
Dim xA As Range, xB As Range, N%
Sheets(2).Cells.Clear
Set xA = Sheets(1).[a1]
Set xB = Sheets(2).[a1]
Do
   xA.Resize(10, 5).Copy xB(1, N * 6 + 1)
   N = N + 1: Set xA = xA(11)
   If N = 4 Then Set xB = xB(12, 1): N = 0
Loop Until xA = ""
End Sub

aails6543

谢谢各位老师赐教