[已解决]数据格式转换

张雄友

数据格式转换，谢谢！

最佳答案

月排行榜 / 总排行榜

爱疯

2014-10-11 20:21

Sub test5()
    Dim A, B, BT, r%, c, i, j, k
    Dim n       '【几人为一组】
    Dim t       '【输出区以1组为1条，共几条】
    Dim g       '【每组之间隔几列】
    Dim s       '输出区的行数
    Dim zu%     '组的序号
    Dim py      '工作表列的偏移

    n = 7
    t = 3
    g = 2
    Range("AW:IV").ClearContents
    r = Range("m65536").End(xlUp).Row - 2
    If r Mod n = 0 Then
        zu = r / n
    Else
        zu = r / n + 1
    End If
    r = zu * n    '让成员的个数，补充为n的倍数
    BT = [m2:p2]
    A = Range("m3:p" & r + 2)
    c = UBound(A, 2)
    ReDim B(1 To zu * (n + 3), 1 To (c + g) * t - g)    '3 = 序号占1行+标题占1行+空行占1行
    zu = 0: s = 1
   
    For i = 1 To r - n + 1 Step n    '从第1组第1行，到最后1组第1行
        zu = zu + 1
        If zu Mod t = 1 Then py = 0    '如果组在第1条，就没有组列的偏移
        '1）序号
        B(s, c + py) = zu
        '2）标题
        For j = 1 To c
            B(s + 1, j + py) = BT(1, j)
        Next j
        '3）组中的人员
        For k = 1 To n    '从组里的第1个成员，到组里的第n个成员
            For j = 1 To c
                'B(组的基 + 本组已用行数 + 行的偏移,列 + 工作表列的偏移)
                B(s + 1 + k, j + py) = A(i + k - 1, j)
            Next j
        Next k
        py = py + c + g    '相对输出区的第1列的偏移量
        If zu Mod t = 0 Then s = s + n + 3    '如果组在最后1条，就增加组的基数
    Next i
    [aw2].Resize(UBound(B), UBound(B, 2)) = B
End Sub

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. Dim i&, s&
   
3. s = 2
   
4. For i = 3 To Cells(Rows.Count, "m").End(xlUp).Row Step 4
   
5.     Range("m2").Resize(1, 4).Copy Cells(s, "ax")
   
6.     Cells(i, "m").Resize(4, 4).Copy Cells(s + 1, "ax")
   
7.     s = s + 6
   
8. Next
   
9. End Sub

复制代码

dsmch

dsmch 发表于 2014-10-10 19:04

ax 改为bd即可

张雄友

二排一组怎么办？

爱疯

Sub test()
    Dim A, B, r, c, i, j, n, s

    Range("AW:AZ").ClearContents
    A = Range("m2").CurrentRegion
    r = UBound(A)
    c = UBound(A, 2)
    n = 2
    '新行数 = 插入行数 +  原行数（因为原行数里有“1”行标题，有了这个“1”，就省了在外面+1）
    ReDim B(1 To Int(r / n) + r, 1 To c)
    n = n + 1
    s = 1

    '存标题
    For j = 1 To c
        B(1, j) = A(1, j)
    Next j

    '存数据
    For i = 2 To r
        s = s + 1
        For j = 1 To c
            B(s, j) = A(i, j)
        Next j

        '判断下一次s是否需要跳过
        If s Mod n = 0 Then s = s + 1
    Next i

    [aw2].Resize(UBound(B), UBound(B, 2)) = B
End Sub

dsmch

1. Sub Macro1()
   
2. Dim i&, s&, n%
   
3. [bd:bg].ClearContents
   
4. s = 2: n = 2 'n为若干组
   
5. For i = 3 To Cells(Rows.Count, "m").End(xlUp).Row Step n
   
6.     Range("m2").Resize(1, 4).Copy Cells(s, "bd")
   
7.     Cells(i, "m").Resize(n, 4).Copy Cells(s + 1, "bd")
   
8.     s = s + n + 2
   
9. Next
   
10. End Sub

复制代码

张雄友

爱疯 发表于 2014-10-10 21:10
Sub test()
    Dim A, B, r, c, i, j, n, s

请版主看4楼附件，而且生成数据时每一组都有标题的。

爱疯

Sub test2()
    Dim A, B, r, c, i, j, k, n, s
    Range("AW:AZ").ClearContents
    A = Range("m2").CurrentRegion
    r = UBound(A)
    c = UBound(A, 2)
    n = 4
    ReDim B(1 To 65536, 1 To c)
    s = 1

    For i = 1 To r - n Step n
        For j = 1 To c
            B(s, j) = A(1, j)
        Next j
        For k = 1 To n
            For j = 1 To c
                '当前块的首行 + 偏移量
                B(s + k, j) = A(i + k, j)
            Next j
        Next k
        s = s + n + 2
    Next i
    [aw2].Resize(s, c) = B
End Sub

张雄友

爱疯 发表于 2014-10-10 22:37
Sub test2()
    Dim A, B, r, c, i, j, k, n, s
    Range("AW:AZ").ClearContents

请看4楼附件，BE：BN 区域，是左右二排并列的，并且有序号的效果。深夜打扰了。

爱疯

Sub test3()
    Dim A, B, BT, r, c, i, j, k
    Dim n       '定义多少人为1组
    Dim s       '输出行数
    Dim zu%     '组
    Dim py      '列偏移

    n = 20  '【手动定义几个人为1组】
    Range("AW:BE").ClearContents
    BT = [m2:p2]
    A = Range("m3:p" & Range("m65536").End(xlUp).Row + n)
    r = UBound(A)
    c = UBound(A, 2)
    If r Mod n = 0 Then zu = r / n Else zu = r / n + 1
    ReDim B(1 To zu * (n + 3), 1 To c * 2 + 1)    '3 = 序号 + 标题 + 空行
    zu = 0

    For i = 1 To r - n Step n
        zu = zu + 1
        s = s + 1
        If zu Mod 2 = 1 Then py = 0 Else py = c + 1: s = s - (n + 3)

        '1）序号
        B(s, c + py) = zu

        '2）标题
        For j = 1 To c
            B(s + 1, j + py) = BT(1, j)
        Next j

        '3）组中的人员
        For k = 1 To n
            For j = 1 To c
                'B(组的基 + 本组已用行数 + 行的偏移,列 + 列的偏移)
                B(s + 1 + k, j + py) = A(i + k - 1, j)
            Next j
        Next k
        s = s + n + 2
    Next i
    [aw2].Resize(s, UBound(B, 2)) = B
End Sub
数据重排3.rar (62.68 KB, 下载次数: 6)

2014-10-11 09:59 上传

点击文件名下载附件