Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 2148|回复: 4

[已解决]按指定列分页打印(最后一行带合计)

[复制链接]
发表于 2016-3-22 09:09 | 显示全部楼层 |阅读模式
本帖最后由 暗夜男 于 2016-3-22 16:03 编辑

附件内详

按指定列分页打印(最后一行带合计).rar (7.45 KB, 下载次数: 7)
发表于 2016-3-22 14:59 | 显示全部楼层    本楼为最佳答案   
  1. Sub tt()
  2.     Dim bt As Range
  3.     arr = Sheet1.[a1].CurrentRegion
  4.     Set d = CreateObject("scripting.dictionary")
  5.     Set d1 = CreateObject("scripting.dictionary")
  6.     Set bt = Sheet1.[a1:d1]
  7.     For i = 2 To UBound(arr) - 1
  8.         x = arr(i, 2)
  9.         d1(x) = d1(x) + arr(i, 4)
  10.         If Not d.exists(x) Then
  11.             Set d(x) = Union(bt, Sheet1.Cells(i, 1).Resize(1, 4))
  12.         Else
  13.             Set d(x) = Union(d(x), Sheet1.Cells(i, 1).Resize(1, 4))
  14.         End If
  15.     Next
  16.     Worksheets.Add after:=Sheets(Sheets.Count)
  17.     With ActiveSheet
  18.         For Each x In d.keys
  19.             r = .[a65536].End(3).Row + 2
  20.             If r = 3 Then r = 1
  21.             d(x).Copy .Cells(r, 1)
  22.             r = .[a65536].End(3).Row + 1
  23.             .Cells(r, 1) = "合计"
  24.             .Cells(r, 1).Resize(1, 3).Merge
  25.             .Cells(r, 1).Resize(1, 3).HorizontalAlignment = xlCenter
  26.             .Cells(r, 4) = d1(x)
  27.             .HPageBreaks.Add Before:=.Cells(r + 1, 1)
  28.             .Cells(r, 1).CurrentRegion.Borders.LineStyle = 1
  29.         Next
  30.     End With
  31. End Sub
复制代码

按指定列分页打印(最后一行带合计).rar

16.36 KB, 下载次数: 10

回复

使用道具 举报

 楼主| 发表于 2016-3-22 16:06 | 显示全部楼层
grf1973 发表于 2016-3-22 14:59

感谢

我以为举例子+改改代码就能解决= =没想到代码参数略多,看不懂

现在把原表发上来,麻烦您给改下代码,要求以B列为基准分页然后E至Z列求和

按指定列分页打印(最后一行带合计).rar (19.13 KB, 下载次数: 4)
回复

使用道具 举报

发表于 2016-3-22 16:20 | 显示全部楼层
小改一下。

按指定列分页打印(最后一行带合计).rar

14.78 KB, 下载次数: 4

回复

使用道具 举报

发表于 2016-3-22 16:27 | 显示全部楼层
没注意E--Z列都要汇总。再改。
  1. Sub tt()
  2.     Dim bt As Range
  3.     With Sheets(1)
  4.         arr = .Range("a1:ab" & .[b65536].End(3).Row)
  5.         Set d = CreateObject("scripting.dictionary")
  6.         Set bt = .[a1:ab8]
  7.         For i = 9 To UBound(arr)
  8.             x = arr(i, 2)
  9.             If Not d.exists(x) Then
  10.                 Set d(x) = Union(bt, .Range("a" & i & ":ab" & i))
  11.             Else
  12.                 Set d(x) = Union(d(x), .Range("a" & i & ":ab" & i))
  13.             End If
  14.         Next
  15.     End With
  16.     Worksheets.Add after:=Sheets(Sheets.Count)
  17.     With ActiveSheet
  18.         For Each x In d.keys
  19.             r1 = .[b65536].End(3).Row + 2
  20.             If r1 = 3 Then r1 = 1
  21.             d(x).Copy .Cells(r1, 1)
  22.             r = .[b65536].End(3).Row + 1
  23.             .Cells(r, 1) = "合计"
  24.             .Cells(r, 1).Resize(1, 4).Merge
  25.             .Cells(r, 1).Resize(1, 4).HorizontalAlignment = xlCenter
  26.             .Cells(r, 5).Resize(1, 22).Formula = "=sum(r" & r1 + 8 & "c:r[-1]c)"         'E列--Z列用公式计算
  27.             .HPageBreaks.Add Before:=.Cells(r + 1, 1)
  28.             .Cells(r, 1).CurrentRegion.Borders.LineStyle = 1
  29.         Next
  30.     End With
  31. End Sub
复制代码

按指定列分页打印(最后一行带合计).rar

13.12 KB, 下载次数: 9

回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 16:09 , Processed in 0.601839 second(s), 9 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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