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

grf1973

一并做在“点击”里面

lidayu

grf1973 发表于 2015-12-22 20:30
一并做在“点击”里面

grf1973 您好，是要这种排序，不 够到最后的排序有点问题，是想每页4列、每列排满后再排到下一页。
另外一点希望能在每页（如第一页到58行下面插入“分页符”是担心打印时超出或减少）
烦请您再修改下,谢谢

lidayu

grf1973 发表于 2015-12-22 20:30
一并做在“点击”里面

grf1973 发表于 2015-12-22 20:30
一并做在“点击”里面

grf1973 您好，就是要这种排序。
另外能否能在每页（例如：第一页到58行（A59）下面插入 “分页符” 是担心 “行高及字体大小” 影响打印时每个单位的数据对不上号），并设置打印 “水平居中”。
烦请您再添加一下,谢谢！

grf1973

请看附件。

lidayu

grf1973 发表于 2015-12-23 08:51
请看附件。

grf1973 您好，现在出了一小问题，如果“数据源表”的警号改为A列，单位改为C列运行就出现下标越界，请您再帮我看看问题出在哪，谢谢！
附图片

grf1973

可能是数据表定义问题，你用arr=sheets("数据源表").range("a1:c" & sheets("数据源表").[a65536].end(3).row)             试试

grf1973

因为currentregion适用于连续区域，看你图片中间B列似乎是空列。

lidayu

grf1973 发表于 2015-12-23 16:40
可能是数据表定义问题，你用arr=sheets("数据源表").range("a1:c" & sheets("数据源表").[a65536].end(3).r ...

grf1973 您好，用这样改了后是可以拉。要怎么添加一句“行高固定”请您赐教谢谢！

lidayu

grf1973 发表于 2015-12-23 16:40
可能是数据表定义问题，你用arr=sheets("数据源表").range("a1:c" & sheets("数据源表").[a65536].end(3).r ...

grf1973 老师您好，把代码复制到实际工作簿中出现“下标越界”请您再帮修改，谢谢！ 调试.rar (80.27 KB, 下载次数: 4)

2015-12-23 19:48 上传

点击文件名下载附件

lidayu

grf1973 发表于 2015-12-23 16:40
因为currentregion适用于连续区域，看你图片中间B列似乎是空列。

grf1973 老师您好,就差一步就完成了，就是运行到
    Dim brr()
'    arr = Sheets("数据源表").[a1].CurrentRegion
    arr = Sheets("sheet1").Range("a1:c" & Sheets("sheet1").[a65536].End(3).Row) '数据源表 arr = 范围
    Set d = CreateObject("scripting.dictionary")
    Set d1 = CreateObject("scripting.dictionary")
    ReDim crr(1 To UBound(arr) + 100)
    For i = 2 To UBound(arr)
        If arr(i, 1) <> "" Then '数据源表数据列
            x = arr(i, 3) '数据源表条件列
            d(x) = d(x) + 1
            If d(x) = 1 Then
                n = n + 1
                crr(n) = x & "   计："
            End If
            n = n + 1
            crr(n)= arr(i, 1)
时出现“下标越界”，您就好人帮到底，我摸索了很久都弄不好，您高手一点拨就能解决问题，楼上呈上符件供您调试，谢谢啦！