[已解决]数据格式转换

爱疯

Sub test4()
    Dim A, B, BT, r, c, i, j, k
    Dim n
    Dim gl
    Dim fz
    Dim s       '输出区的行数
    Dim zu%     '组的序号
    Dim py      '工作表列的偏移

    n = 7       '【几人为一组】
    fz = 4      '【输出去如果1组是1列，共有多少列】
    gl = 1      '【每组之间隔几列】
    Range("AW:IV").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 + gl) * fz - gl)
    zu = 0: s = 1

    For i = 1 To r - n Step n
        zu = zu + 1
        If zu Mod fz = 1 Then py = 0

        '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
        py = py + c + gl
        If zu Mod fz = 0 Then s = s + n + 3
    Next i
    [aw2].Resize(s, UBound(B, 2)) = B
End Sub



想晕了，不想了。。。。。好像没错
手动修改 n，fz，gl 吧

张雄友

爱疯 发表于 2014-10-11 11:32
Sub test4()
    Dim A, B, BT, r, c, i, j, k
    Dim n

test4  代码实现的效果导致最后二个员工没有转换到。就是当数据不是整除时，最后有几个没有转换到。

Sub test4()
    Dim A, B, BT, r, c, i, j, k
    Dim n
    Dim gl
    Dim fz
    Dim s       '输出区的行数
    Dim zu%     '组的序号
    Dim py      '工作表列的偏移

    n = 7       '【几人为一组】
    fz = 2      '【输出去如果1组是1列，共有多少列】
    gl = 1      '【每组之间隔几列】
    Range("AW:IV").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 + gl) * fz - gl)
    zu = 0: s = 1

    For i = 1 To r - n Step n
        zu = zu + 1
        If zu Mod fz = 1 Then py = 0

        '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
        py = py + c + gl
        If zu Mod fz = 0 Then s = s + n + 3
    Next i
    [aw2].Resize(s, UBound(B, 2)) = B
End Sub

爱疯

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

张雄友

爱疯 发表于 2014-10-11 20:21
Sub test5()
    Dim A, B, BT, r%, c, i, j, k
    Dim n       '【几人为一组】

test4   修改最后一句代码也可以的，测试了一些数据。不知对不对？？？？？

Sub test4()
    Dim A, B, BT, r, c, i, j, k
    Dim n
    Dim gl
    Dim fz
    Dim s       '输出区的行数
    Dim zu%     '组的序号
    Dim py      '工作表列的偏移

    n = 7       '【几人为一组】
    fz = 2      '【输出去如果1组是1列，共有多少列】
    gl = 1      '【每组之间隔几列】
    Range("AW:IV").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 + gl) * fz - gl)
    zu = 0: s = 1

    For i = 1 To r - n Step n
        zu = zu + 1
        If zu Mod fz = 1 Then py = 0

        '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
        py = py + c + gl
        If zu Mod fz = 0 Then s = s + n + 3
    Next i
    [aw2].Resize(zu * (n + 3) , UBound(B, 2)) = B
End Sub

爱疯

    For i = 1 To r - n Step n
    Next i
这是一组组循环，从第1组到最后1组，最后1组
如果刚好n个人，不会越界；
如果不足n个人，更不会越界。


For i = 1 To r - n+1 Step n
Next i
我这么写，只不过自己觉得好理解些。Test5前面，将人员总数凑足为n的倍数，确实没必要。是因为查错时。。。。小心过头了，就用14楼吧，可以的。