[已解决]提取数据均分为多列

lidayu

垦请老师赐教如何才能实现工作簿中的要求，详情附件中说明 提取数据并均分为多列151222.rar (181.58 KB, 下载次数: 12)

2015-12-22 15:14 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

爱疯

2015-12-22 19:18

提取数据并均分为多列151222c.rar (184.93 KB, 下载次数: 10)

2015-12-22 19:40 上传

点击文件名下载附件

虽然问题已解决了，但也许还会碰到类似的问题，以备后用。



Sub reformatting()
    Dim A               '数据源
    Dim B               '结果
    Dim groupCount      '组的总个数
    Dim memberX         '每组中的行数
    Dim memberY         '每组中的列数
    Dim groupX          '组矩阵的行数
    Dim groupY          '组矩阵的列数
    Dim currentGroup    '当前组
    Dim i, j, r, c, tmp


    '1）已知数据
    A = Sheets(1).Range("a1").CurrentRegion
    memberX = 43
    memberY = 4
    groupY = 3


    '2）相关数据
    groupCount = getX(UBound(A) - 1, memberX)    '求有多少组
    groupX = getX(groupCount, groupY)
    ReDim B(1 To groupX * memberX, 1 To groupY * memberY)  'B的大小


    '3）生成数组B
    For i = 2 To UBound(A)
        currentGroup = getX(i - 1, memberX)    '序号属于第几组

        '求r
        r = getX(currentGroup, groupY)         '当前组，在组矩阵中是第几行
        r = (r - 1) * memberX             '当前组，在数组B中从第几行开始（未加偏移行数）
        r = r + getY(i - 1, memberX)      '加上偏移行数


        '求c
        c = getY(currentGroup, groupY)         '当前组，在组矩阵中是第几列
        c = (c - 1) * memberY             '当前组，在数组B中从第几列开始

        '确定
        B(r, c + 1) = A(i, 1)
        B(r, c + 2) = A(i, 2)
        B(r, c + 3) = A(i, 7)
        B(r, c + 4) = A(i, 11)
    Next i


    '4）输出
    With Sheets(4)
        .Rows("3:65536").ClearContents
        .Range("a3").Resize(UBound(B), UBound(B, 2)) = B
    End With

End Sub

'获取横坐标
Function getX(x, y)
    Dim tmp
    tmp = x \ y
    getX = IIf(tmp = x / y, tmp, tmp + 1)
End Function

'获取纵坐标
Function getY(x, y)
    Dim tmp
    tmp = x Mod y
    getY = IIf(tmp, tmp, y)
End Function

跳转到最佳答案楼层

爱疯

提取数据并均分为多列151222c.rar (184.93 KB, 下载次数: 10)

2015-12-22 19:40 上传

点击文件名下载附件

虽然问题已解决了，但也许还会碰到类似的问题，以备后用。



Sub reformatting()
    Dim A               '数据源
    Dim B               '结果
    Dim groupCount      '组的总个数
    Dim memberX         '每组中的行数
    Dim memberY         '每组中的列数
    Dim groupX          '组矩阵的行数
    Dim groupY          '组矩阵的列数
    Dim currentGroup    '当前组
    Dim i, j, r, c, tmp


    '1）已知数据
    A = Sheets(1).Range("a1").CurrentRegion
    memberX = 43
    memberY = 4
    groupY = 3


    '2）相关数据
    groupCount = getX(UBound(A) - 1, memberX)    '求有多少组
    groupX = getX(groupCount, groupY)
    ReDim B(1 To groupX * memberX, 1 To groupY * memberY)  'B的大小


    '3）生成数组B
    For i = 2 To UBound(A)
        currentGroup = getX(i - 1, memberX)    '序号属于第几组

        '求r
        r = getX(currentGroup, groupY)         '当前组，在组矩阵中是第几行
        r = (r - 1) * memberX             '当前组，在数组B中从第几行开始（未加偏移行数）
        r = r + getY(i - 1, memberX)      '加上偏移行数


        '求c
        c = getY(currentGroup, groupY)         '当前组，在组矩阵中是第几列
        c = (c - 1) * memberY             '当前组，在数组B中从第几列开始

        '确定
        B(r, c + 1) = A(i, 1)
        B(r, c + 2) = A(i, 2)
        B(r, c + 3) = A(i, 7)
        B(r, c + 4) = A(i, 11)
    Next i


    '4）输出
    With Sheets(4)
        .Rows("3:65536").ClearContents
        .Range("a3").Resize(UBound(B), UBound(B, 2)) = B
    End With

End Sub

'获取横坐标
Function getX(x, y)
    Dim tmp
    tmp = x \ y
    getX = IIf(tmp = x / y, tmp, tmp + 1)
End Function

'获取纵坐标
Function getY(x, y)
    Dim tmp
    tmp = x Mod y
    getY = IIf(tmp, tmp, y)
End Function

lidayu

爱疯 发表于 2015-12-22 19:18
虽然问题已解决了，但也许还会碰到类似的问题，以备后用。

  爱疯版主您好，就是要这样的效果，非常感谢您的赐教，能否在每页最后一行（就是序号43后面）插入“分页符”预防打印时出现错误。能得到您的帮助感激涕零！谢谢您！

lidayu

爱疯 发表于 2015-12-22 19:18
虽然问题已解决了，但也许还会碰到类似的问题，以备后用。

爱疯版主您好，如果换成这样 0907提取数据并均分为多列.rar (41.37 KB, 下载次数: 6)

2015-12-22 20:11 上传

点击文件名下载附件 要怎么实现，请您赐教！

爱疯

Option Explicit

Sub reformatting()
    Dim A               '数据源
    Dim B               '结果
    Dim groupCount      '组的总个数
    Dim memberX         '每组中的行数
    Dim memberY         '每组中的列数
    Dim groupX          '组矩阵的行数
    Dim groupY          '组矩阵的列数
    Dim currentGroup    '当前组
    Dim i, j, r, c, tmp


    '1）已知数据
    A = Sheets(1).Range("a1").CurrentRegion
    memberX = 43
    memberY = 4
    groupY = 3


    '2）相关数据
    groupCount = getX(UBound(A) - 1, memberX)    '求有多少组
    groupX = getX(groupCount, groupY)
    ReDim B(1 To groupX * memberX, 1 To groupY * memberY)  'B的大小


    '3）生成数组B
    For i = 2 To UBound(A)
        currentGroup = getX(i - 1, memberX)     '序号属于第几组

        '求r
        r = getX(currentGroup, groupY)          '当前组，在组矩阵中是第几行
        r = (r - 1) * memberX                   '当前组，在数组B中从第几行开始（未加偏移行数）
        r = r + getY(i - 1, memberX)            '加上偏移行数


        '求c
        c = getY(currentGroup, groupY)          '当前组，在组矩阵中是第几列
        c = (c - 1) * memberY                   '当前组，在数组B中从第几列开始

        '确定
        B(r, c + 1) = A(i, 1)
        B(r, c + 2) = A(i, 2)
        B(r, c + 3) = A(i, 7)
        B(r, c + 4) = A(i, 11)
    Next i


    '4）输出
    With Sheets(4)
        .Rows("3:65536").ClearContents
        .Range("a3").Resize(UBound(B), UBound(B, 2)) = B
    End With

    '5）打印
    Call myPrint(3, 3 + UBound(B) - 1, memberX)

End Sub

'获取横坐标
Function getX(x, y)
    Dim tmp
    tmp = x \ y
    getX = IIf(tmp = x / y, tmp, tmp + 1)
End Function

'获取纵坐标
Function getY(x, y)
    Dim tmp
    tmp = x Mod y
    getY = IIf(tmp, tmp, y)
End Function

'打印
Sub myPrint(x, y, z)
    Dim i
    With Sheets(4)
        .PageSetup.PrintArea = .Range("a1").CurrentRegion.Address
        .PageSetup.Orientation = xlPortrait     '纵向
        .PageSetup.PrintTitleRows = "$1:$2"     '标题行
        .ResetAllPageBreaks                     '重置分页符
        For i = x To y Step z
            If i > 1 Then .HPageBreaks.Add Cells(i, 1)
        Next i
    End With
End Sub

提取数据并均分为多列151222d.rar (187.46 KB, 下载次数: 7)

2015-12-22 20:36 上传

点击文件名下载附件

lidayu

爱疯 发表于 2015-12-22 20:36
Option Explicit

Sub reformatting()

爱版您好，打印预览好像不对，请您再帮我看看，另外希望0907的那表您能帮我实现，谢谢您无私的帮助！

爱疯

lidayu 发表于 2015-12-22 20:12
爱疯版主您好，如果换成这样要怎么实现，请您赐教！

0907提取数据并均分为多列2.rar (63.59 KB, 下载次数: 9)

2015-12-22 21:39 上传

点击文件名下载附件

因为与1楼要求类似，所以在开始添加了一个getSource()，用于替代源数组。其它代码是改自5楼。
见图，有空格的还留着要紧吗？如果要删，得再改，还得花点时间。。。先下电脑了

爱疯

lidayu 发表于 2015-12-22 21:40
爱版您好，打印预览好像不对，请您再帮我看看，另外希望0907的那表您能帮我实现，谢谢您无私的帮助！

打印预览什么地方不对？怎样才对，需具体说明，才好检查。

注意：打印的第1页只有标题行，是不需要的（浪费纸了）。从第2页开始才是需要的。

lidayu

爱疯 发表于 2015-12-22 21:44
因为与1楼要求类似，所以在开始添加了一个getSource()，用于替代源数组。其它代码是改自5楼。
见 ...

爱版您好，遇空保留着，另外打印预览出现如下图：
第一页只有标题栏，要去除标题栏。

第二页的原因找到了只把行数43改成56就对了

爱疯

lidayu 发表于 2015-12-22 22:01
爱版您好，遇空保留着，另外打印预览出现如下图：
第一页只有标题栏，要去除标题栏。

提取数据并均分为多列151222e.rar (184.97 KB, 下载次数: 7)

2015-12-23 09:41 上传

点击文件名下载附件

回1楼的。
现在，预览时第1页仍是只有表头，但打印从第2页开始。