数据重排

芒芒芒果

有一组6*n的数据（行数固定为6行，n为列数每次都不确定），希望将数据重排成每两列为一行
为了看得更清楚，每列数据我都用不同的背景色区分开来了，写了好久写不对，望大家帮忙写下代码
数据重排.7z (6.66 KB, 下载次数: 7)

2018-4-27 16:10 上传

点击文件名下载附件

yylucke

请参考
Private Sub CommandButton1_Click()
    Dim MaxColumn, MyArr, MyColumn, MyRow
    With Sheet1
    MaxColumn = .Range("1:1").End(xlToRight).Column
    MyRow = 20
   
    For i = 1 To MaxColumn
        .Range(.Cells(1, i), .Cells(6, i)).Copy
        If i Mod 2 = 1 Then
            MyRow = MyRow + 1
            MyColumn = 1
        Else
            MyColumn = 7
        End If
        .Cells(MyRow, MyColumn).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Next i
    End With
End Sub

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   With Worksheets("sheet1")
   
5.     c = .Cells(1, .Columns.Count).End(xlToLeft).Column
   
6.     arr = .Range("a1").Resize(6, c)
   
7.     ReDim brr(1 To UBound(arr, 2) / 2, 1 To 12)
   
8.     For j = 1 To UBound(arr, 2) Step 2
   
9.       m = m + 1
   
10.       For i = 1 To UBound(arr)
    
11.         brr(m, i) = arr(i, j)
    
12.         brr(m, i + 6) = arr(i, j + 1)
    
13.       Next
    
14.     Next
    
15.     .Range("a15").Resize(UBound(brr), UBound(brr, 2)) = brr
    
16.   End With
    
17. End Sub
    

复制代码

chxw68

详见附件。

不知道为什么

如图，供楼主参考

不知道为什么

附件         

芒芒芒果

yylucke 发表于 2018-4-27 16:49
请参考
Private Sub CommandButton1_Click()
    Dim MaxColumn, MyArr, MyColumn, MyRow

大家都好热情，谢谢谢谢~

芒芒芒果

chxw68 发表于 2018-4-27 16:58
详见附件。

学习了，大家都好热情，谢谢谢谢~

芒芒芒果

不知道为什么 发表于 2018-4-27 17:09
附件

又学习了，大家都好热情，谢谢谢谢~