老师们，帮忙！！！能不能自动按管理部门分页打印。管理部门非常多，我只是截取一部分

shsj2018

管理部门	非资产名称	数量	品牌	备注
办公室	桌椅	1
办公室	热水器	1	史密斯
施贤港泵闸	冰箱	1	松下
大邱泾泵闸	空调	1	海尔	立式
大邱泾泵闸	热水器	1	史密斯
物资科	油烟机	1	帅康
物资科	空调	1	大金	立式
二里泾泵闸	电视机	1	康佳
财务科	吸油烟机	1	德意
财务科	热水器	1	史密斯
长浜	空调	2	格力
长浜	椅子	2
长浜	吸油烟机	1	德意
长浜	热水器	1	史密斯
马王泾	空调	2	格力
小斜塘水闸	桌子	1
小斜塘水闸	椅子	1
小斜塘水闸	油烟机	1	帅康
古浦塘中闸	热水器	1	史密斯
古浦塘中闸	电视机	1	帅康
古浦塘中闸	监控显示器	1
古浦塘中闸	吸油烟机	1	帅康
横泾港泵闸	空调	3	三菱 格力 海信
横泾港泵闸	桌子	2
生产科	椅子	2
生产科	显示器	1
横泾港泵闸	冰箱	1	小天鹅
横泾港泵闸	油烟机	1	华帝
横泾港泵闸	热水器	1	史密斯
银河东泵闸	空调	2	海尔
银河东泵闸	打印机	1	惠普
物流科	电脑	2	三星
物流科	空调	1	海尔	立式
银河东泵闸	热水器	1	史密斯
银河东泵闸	吸油烟机	1	帅康
张家浜泵闸	空调	1	美的
张家浜泵闸	热水器	1	史密斯
总务科	吸油烟机	1	帅康
总务科	冰箱	1	松下
张家浜泵闸	桌子	1
张家浜泵闸	椅子	1
沈泾塘泵闸	空调	1	格力

shsj2018

怕沉了，自己顶顶，对不住了。

shsj2018

先在这里谢谢老师了

LMY123

shsj2018 发表于 2018-8-27 15:36
先在这里谢谢老师了

怎么打印，是否按模板打印？

hasyh2008

可分类汇总，设置接部门分页打印。

shsj2018

谢谢上面的两位老师.群里的高手，能不能帮忙写个VBA呀，先谢啦

一指禅62

shsj2018 发表于 2018-8-28 08:35
谢谢上面的两位老师.群里的高手，能不能帮忙写个VBA呀，先谢啦

发给文件上来撒。

shsj2018

在这里先谢谢了

hzruziniu

shsj2018 发表于 2018-8-28 10:36
在这里先谢谢了

1. '打开工作表生成不重复值下拉
   
2. Private Sub Worksheet_Activate()
   
3.     Dim arr, d As Object
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     r = Range("a65536").End(xlUp).Row
   
6.     arr = Range("a2:a" & r)
   
7.     For i = 1 To UBound(arr)
   
8.         d(arr(i, 1)) = ""
   
9.     Next
   
10.     With Range("j1").Validation
    
11.         .Delete
    
12.         .Add 3, 1, 1, Join(d.keys, ",")
    
13.     End With
    
14. End Sub
    
15. '下拉选取管理部门进行单项打印
    
16. Private Sub Worksheet_Change(ByVal Target As Range) '下拉或单元格值变化事件
    
17.     If Target.Address = "$J$1" Then
    
18.         If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData
    
19.         Range("A1").CurrentRegion.AutoFilter Field:=1, Criteria1:=Range("j1")
    
20.         ActiveWindow.SelectedSheets.PrintPreview   '先打印预览(测试时启用/停用下一句)
    
21.         'ActiveWindow.SelectedSheets.PrintOut   '后打印当前表(测试通过正式打印时启用/停用上一句)
    
22.     End If
    
23. End Sub
    
24. 
    
25. '点击连续打印打印所有管理部门
    
26. Private Sub CommandButton1_Click()
    
27.     Dim r%, i%
    
28.     Dim arr, k, s
    
29.     Dim d As Object
    
30.     Set d = CreateObject("scripting.dictionary")
    
31.     r = Range("a65536").End(xlUp).Row
    
32.     arr = Range("a2:a" & r)
    
33.     For i = 1 To UBound(arr)
    
34.         d(arr(i, 1)) = ""
    
35.     Next
    
36.     For i = 1 To d.Count
    
37.         If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData
    
38.         Range("A1").CurrentRegion.AutoFilter Field:=1, Criteria1:=Application.Index(d.keys, 0, i)
    
39.         ActiveWindow.SelectedSheets.PrintPreview   '先打印预览(测试时启用/停用下一句)
    
40.         'ActiveWindow.SelectedSheets.PrintOut   '后打印当前表(测试通过正式打印时启用/停用上一句)
    
41.     Next
    
42. End Sub
    
43. 
    
44. '取消筛选
    
45. Private Sub CommandButton2_Click()
    
46. ActiveSheet.ShowAllData
    
47. End Sub
    

复制代码

hzruziniu

1. '打开工作表生成不重复值下拉
   
2. Private Sub Worksheet_Activate()
   
3.     Dim arr, d As Object
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     r = Range("a65536").End(xlUp).Row
   
6.     arr = Range("a2:a" & r)
   
7.     For i = 1 To UBound(arr)
   
8.         d(arr(i, 1)) = ""
   
9.     Next
   
10.     With Range("j1").Validation
    
11.         .Delete
    
12.         .Add 3, 1, 1, Join(d.keys, ",")
    
13.     End With
    
14. End Sub
    
15. '下拉选取管理部门进行单项打印
    
16. Private Sub Worksheet_Change(ByVal Target As Range) '下拉或单元格值变化事件
    
17.     If Target.Address = "$J$1" Then
    
18.         If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData
    
19.         Range("A1").CurrentRegion.AutoFilter Field:=1, Criteria1:=Range("j1")
    
20.         ActiveWindow.SelectedSheets.PrintPreview   '先打印预览(测试时启用/停用下一句)
    
21.         'ActiveWindow.SelectedSheets.PrintOut   '后打印当前表(测试通过正式打印时启用/停用上一句)
    
22.     End If
    
23. End Sub
    
24. 
    
25. '点击连续打印打印所有管理部门
    
26. Private Sub CommandButton1_Click()
    
27.     Dim r%, i%
    
28.     Dim arr, k, s
    
29.     Dim d As Object
    
30.     Set d = CreateObject("scripting.dictionary")
    
31.     r = Range("a65536").End(xlUp).Row
    
32.     arr = Range("a2:a" & r)
    
33.     For i = 1 To UBound(arr)
    
34.         d(arr(i, 1)) = ""
    
35.     Next
    
36.     For i = 1 To d.Count
    
37.         If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData
    
38.         Range("A1").CurrentRegion.AutoFilter Field:=1, Criteria1:=Application.Index(d.keys, 0, i)
    
39.         ActiveWindow.SelectedSheets.PrintPreview   '先打印预览(测试时启用/停用下一句)
    
40.         'ActiveWindow.SelectedSheets.PrintOut   '后打印当前表(测试通过正式打印时启用/停用上一句)
    
41.     Next
    
42. End Sub
    
43. 
    
44. '取消筛选
    
45. Private Sub CommandButton2_Click()
    
46. ActiveSheet.ShowAllData
    
47. End Sub
    

复制代码