Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
楼主: lidayu

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

[复制链接]
 楼主| 发表于 2015-12-25 16:25 | 显示全部楼层
grf1973 发表于 2015-12-25 16:06
嗯,增加行数也方便的,代码里直接改就行了。

grf1973 您好,我改63行后看起来效果还行就是字变小了,真是鱼和熊掌不可兼得,呵呵。
回复

使用道具 举报

 楼主| 发表于 2015-12-26 20:06 | 显示全部楼层
grf1973 发表于 2015-12-25 16:06
嗯,增加行数也方便的,代码里直接改就行了。

grf1973 您好,这段代码在新工作簿中好像不能实现自动:调整为1页宽,请您试试看。
     With ActiveSheet.PageSetup
          .CenterHorizontally = True      '工作表打印居中
          .PrintTitleRows = "$1:$1"   '打印标题行
          .FitToPagesWide = 1      '调整为1页宽
      End With

回复

使用道具 举报

 楼主| 发表于 2015-12-26 22:44 | 显示全部楼层
grf1973 发表于 2015-12-25 16:06
嗯,增加行数也方便的,代码里直接改就行了。

grf1973 您好,刚才请教的问题已解决了,我添加了红色的两句,现在可以自动“调整为1页宽”,我又把页边距缩小数值这样字体看起来也就大了些,谢谢您的指教。
    With ActiveSheet.PageSetup      '调整最适合打印页面
        .LeftMargin = 13  '左页边距=0.5
        .RightMargin = 13  '右页边距=0.5
        .CenterHorizontally = True      '工作表打印居中
        .PrintTitleRows = "$1:$1"   '打印标题行
        .Zoom = False      '取消绽放比例
        .FitToPagesWide = 1      '调整为1页宽
       .FitToPagesTall = False  '取消页高度
    End With


回复

使用道具 举报

 楼主| 发表于 2018-9-6 20:47 | 显示全部楼层
本帖最后由 lidayu 于 2018-9-19 17:20 编辑
grf1973 发表于 2015-12-25 16:06
嗯,增加行数也方便的,代码里直接改就行了。

grf1973 您好,今天单位有个统计与之前您帮我写的相似,想请您再帮我看看能否实现,详情附件。
新开帖子链接:http://www.excelpx.com/thread-451400-1-1.html
55乘6为1页.rar (175.65 KB, 下载次数: 4)
回复

使用道具 举报

 楼主| 发表于 2018-9-16 11:26 | 显示全部楼层
grf1973 发表于 2015-12-25 16:06
嗯,增加行数也方便的,代码里直接改就行了。

lgrf1973 您好,在工作中碰到新问题,希望能得到您的帮助,菜鸟感激涕零。附件在34楼,新贴:http://www.excelpx.com/thread-451400-1-1.html

回复

使用道具 举报

发表于 2019-4-12 16:03 | 显示全部楼层
Sub 五十八行一页() '计数2
Dim ar, h, l, n
On Error Resume Next
Set d = CreateObject("scripting.dictionary")
ar = Sheets("数据源表").Range("a1").CurrentRegion
Application.ScreenUpdating = False
Sheets("结果表2").Activate
Range("A:D").Clear
For i = 2 To UBound(ar)
     If ar(i, 6) <> "" Then n = n + 1: d(ar(i, 1)) = d(ar(i, 1)) & "," & i
Next i
n = 1: h = 2: l = 1
For Each k In d.keys
     dk = Split(d(k), ",")
     If l = 4 And h > n * 58 Then
        l = 1: n = n + 1
     End If
     Cells(h, l) = k & " " & "计:" & UBound(dk)
     For i = 1 To UBound(dk)
         If h > n * 58 Then
            Cells(h, 1).Resize(1, 4).Borders(xlEdgeBottom).LineStyle = 1
            If l < 4 Then
               l = l + 1: h = (n - 1) * 58 + 1
            Else
               l = 1: n = n + 1
            End If
         End If
         Cells(h + 1, l) = "'" & ar(dk(i), 6)
          h = h + 1
     Next i
      h = h + 1
   
Next k
Application.ScreenUpdating = True
End Sub

回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-28 17:52 , Processed in 1.053852 second(s), 9 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表