Dim?Dic?As?Object
Dim?i?As?Integer,?r?As?Integer
Dim?strPart
r?=?Range("A65536").End(xlUp).Row
Set?Dic?=?CreateObject("scripting.dictionary")?'創建字典對象
For?i?=?2?To?r?'將第壹列數據添加到字典的key值中
Dic(CStr(Cells(i,?1)))?=?""
Next?i
'因字典對象的Key不能重復，結果就是字典對象中保留了所有的部門（每個部門只存有壹個）
Range("A1:D1").Select?'標題行
Selection.AutoFilter?'篩選
ActiveSheet.PageSetup.PrintArea?=?"$A$1:$D$"?&?r'設置打印區域
For?Each?strPart?In?Dic.keys
ActiveSheet.Range("$A$1:$D$"?&?r).AutoFilter?Field:=1,?Criteria1:=strPart'對每個部門進行篩選
ActiveWindow.SelectedSheets.PrintOut?Copies:=1,?Collate:=True,?_
IgnorePrintAreas:=False'打印命令（份數=1，……）
Next
Set?Dic?=?Nothing
End?Sub
A在其他列時或列數較多時更改代碼中的 區域，即將代碼中提到的“A"列換到應該在的壹列，比如C列; ? "$A$1:$D" ?& ?r ? 更改為 ?"$C$1:$H" & r, ?A1:D1也改成相應的區域
右擊工作表——查看代碼——將代碼粘貼過去，運行。