求助好大神！！！表格按某列内容自动筛选打印

wpsvip

请教各位大神，该怎么按A列姓名这列不同的名字自动分类筛选打印（要有标题），表格在附件里，附件里有两个子表，一个是有标题版的一个是没有标题版的，都请大神帮忙看一下，另外请教各位大神，以后的表格也许行数不止这些，列数也不止这些，A列的姓名也不止范例表格里面这几个会有影响吗？
非常感谢！！！

莫名v微笑

1. Sub test()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. arr = Sheets(1).UsedRange
   
4. For i = 3 To UBound(arr)
   
5. d(arr(i, 1)) = i
   
6. Next
   
7. k = d.keys
   
8. For i = 0 To UBound(k)
   
9. Sheets(1).Range(Cells(2, 2), Cells(UBound(arr), UBound(arr, 2))).AutoFilter Field:=1, Criteria1:=k(i)
   
10. With ActiveSheet.PageSetup
    
11.      .PrintTitleRows = "$1:$2"
    
12.      .PrintTitleColumns = ""
    
13.      .Orientation = xlLandscape
    
14.      .Zoom = False
    
15.      .FitToPagesWide = 1
    
16.      .FitToPagesTall = False
    
17. ActiveSheet.PrintOut
    
18. End With
    
19. Next
    
20. End Sub

复制代码

尝试写了个，你试试。

wpsvip

希望大神能帮忙解答一下，谢谢！好人一生平安！

wpsvip

莫名v微笑 发表于 2018-8-13 16:03
尝试写了个，你试试。

刚刚才看到回复，非常感谢！！！能帮我写入EXCEL表格吗，我复制代码到表格里面试了一下无法正常运行。

hzruziniu

1. Sub 筛选打印()
   
2.     Dim d As Object, rng, k, i%
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     Set d = CreateObject("Scripting.Dictionary")
   
6.     r = Range("a65536").End(xlUp).Row
   
7.     rng = Range([a3], "a" & r)
   
8.     For i = 1 To UBound(rng)
   
9.         d(rng(i, 1)) = ""
   
10.     Next
    
11.     For Each k In d.keys
    
12.         Range("A2:S" & r).Select
    
13.         Selection.AutoFilter
    
14.         Selection.AutoFilter Field:=1, Criteria1:=k
    
15.         ActiveSheet.PrintPreview '打印预览
    
16.        ' ActiveSheet.PrintOut    '直接打印
    
17.     Next
    
18.     Application.ScreenUpdating = True
    
19.     Application.DisplayAlerts = True
    
20. End Sub
    
21. 
    
22. Sub 展开()
    
23.     Selection.AutoFilter
    
24. End Sub

复制代码

hzruziniu

请教各位大神非常感谢！.rar (28.42 KB, 下载次数: 45)

2018-8-14 16:26 上传

点击文件名下载附件

wpsvip

hzruziniu 发表于 2018-8-14 16:26

大神，非常感谢你！！！你做的这个是有标题版本的，另外这个无标题版本的代码能帮我写一下吗 非常谢谢！

lsc900707

wpsvip 发表于 2018-8-14 20:16
大神，非常感谢你！！！你做的这个是有标题版本的，另外这个无标题版本的代码能帮我写一下吗 非常谢谢！

依样画葫芦的活，自己动动手呀。

hzruziniu

wpsvip 发表于 2018-8-14 20:16
大神，非常感谢你！！！你做的这个是有标题版本的，另外这个无标题版本的代码能帮我写一下吗 非常谢谢！

1. Sub 筛选打印2()
   
2.     Dim d As Object, rng, k, i%
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     Set d = CreateObject("Scripting.Dictionary")
   
6.     r = Range("a65536").End(xlUp).Row
   
7.     rng = Range([a2], "a" & r)
   
8.     For i = 1 To UBound(rng)
   
9.         d(rng(i, 1)) = ""
   
10.     Next
    
11.     For Each k In d.keys
    
12.         Range("A1:T" & r).Select
    
13.         Selection.AutoFilter Field:=1, Criteria1:=k
    
14.         ActiveSheet.PrintPreview '打印预览
    
15.         'ActiveSheet.PrintOut    '直接打印
    
16.     Next
    
17.     Application.ScreenUpdating = True
    
18.     Application.DisplayAlerts = True
    
19. End Sub
    

复制代码

wpsvip

lsc900707 发表于 2018-8-14 20:55
依样画葫芦的活，自己动动手呀。

哈哈 水平有限，谢谢斑竹！