Excel_VBA_案例分享_將統計表自動依照部門分類儲存成不同檔案

/ Excel, Knowledge / 作者:

【前情提要】R同事好不容易靠著亨利羊的幫助，把原本麻煩的假勤統計表自動化了。以前做報表耗時廢力又容易出錯，現在又快又精準，簡直可以從此以後過著幸福快樂的日子。

但是，人苦不知足，得隴復望蜀。能不能把後續分裝的動作也通通都自動化呢？

 

【問題】把一張含有全公司名單的大表，依照部門分類篩選，存成十幾個小表。過去手動製作的方式是 1.篩選 2.複製 3.貼上 4.另存新檔，並重複十幾次。

該如何把這個過程也都自動化呢？

 

【解法】

這些在儲存格之外做的事，非用到VBA不可了。
(以下程式碼已改寫過，消去公司相關內部資訊)

Sub classify()
 '
 ' classify Macro
 '

fn = Application.ThisWorkbook.Name
 MsgBox "歡迎使用假勤統計小工具，本程式約需兩分鐘，請耐心等候。"
 Dim branch As String
 Application.DisplayAlerts = False

For m = 2 To 12 '總共要生成11個檔案
 Workbooks(fn).Activate
 If Sheets("部門分類").Cells(2, m) = "" Then '打勾的才要做
Else
branch = Sheets("部門分類").Cells(1, m)
MsgBox "現在進行的是" & branch

lastrow = Sheets("部門分類").Cells(1, m).End(xlDown).Row
For Each s In Sheets
 If s.Name = branch Then
 SNN = 1
 Exit For
 Else
 SNN = 0
 End If
 Next
 If SNN = 0 Then
 Sheets.Add
 ActiveSheet.Name = branch
 Else
 Sheets(branch).Select
 End If

'把第一行第二行標題擺上
 Sheets("總表").Select
 Rows("1:2").Select
 Selection.Copy
 Sheets(branch).Select
 Rows("1:2").Select
 ActiveSheet.Paste

For i = 3 To lastrow
 target = Sheets("部門分類").Cells(i, m).Value

Sheets("總表").Select
 Columns("B:B").Select
 Set A = Selection.Find(What:=target, After:=ActiveCell, LookIn:=xlValues, LookAt _
 :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
 False, MatchByte:=False, SearchFormat:=False)
 If Not A Is Nothing Then '如果總表中無此人名 則跳過
 A.Activate
 x = ActiveCell.Row
 Rows(x & ":" & x).Select
 Selection.Copy
 Sheets(branch).Select
 Rows(i & ":" & i).Select
 Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
 SkipBlanks:=False, Transpose:=False
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False
Else
End If
Next
lastcol = Sheets(branch).Cells(lastrow, 1).End(xlToRight).Column
Cells(lastrow + 1, 5) = "合計"
 '合計欄位
 For i = 6 To lastcol

Cells(lastrow + 1, i) = "=SUM(R[-" & lastrow - 2 & "]C:R[-1]C)"

Next

Sheets(branch).Select
 Sheets(branch).Copy
ActiveWorkbook.SaveAs Filename:="H:假勤記錄(季)表_全公司2015auto2015_假勤記錄(季)表_全公司_" & Format(Now, "yy") & Format(Now, "mm") & Format(Now, "dd") & "_" & branch & ".xlsx", _ FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
MsgBox branch & "已完成"
End If
Next '生成檔案迴圈
MsgBox "各部門檔案已生成完畢，存檔路徑為 H:假勤記錄(季)表_全公司2015auto"
End Sub

 

【成果】

原本多個手動步驟，已簡化為一鍵完成：

自動篩選、自動複製貼上、自動加總、自動另存新檔、還自動取好對應的檔名，這一切都只需要……一鍵！

改善工作效率任務，成功…………了一半XD

為什麼說是成功一半？因為這段VBA程式碼在亨利羊自己的桌電上跑起來還算蠻順的，費時不到兩分鐘。畫面劈哩叭啦一閃而過，完全不知道excel在做什麼。但是交給R同事去執行時，才發現電腦效能的差距……R同事可以看著電腦進行每個動作，一朢而知進度做到哪了。實在讓人有點不耐，但又怕同時開其它程式會造成當機。所以我在檔案中的「使用說明」的第4點加註了：

 

使用說明：

1.將EIP匯出之Q4檔案整個貼到”Q4″sheet，若較前三季欄位有所變動，請做必要之修改。
2.貼上後，”總表”sheet即會自動帶入Q4數據。全公司總表即完成。
3.至”部門分類”sheet的第二行，將你這次要出的檔案打勾。
4.按下”一鍵完成”之按鍵，可選擇坐在位置上觀看程式運行，或著利用時間先去上個廁所。 估計所需時間約數分鐘(依個人電腦效能而定)
5.程式運行完畢後，至 H:假勤記錄(季)表_全公司2015auto 檢查所生成之檔案。

本檔案為Henry Yang 依個人理解之作業流程所開發，以創用CC 姓名標示 3.0 台灣 授權條款釋出。
若有任何更新維護上的問題歡迎回報。唯不保證其正確性，建議HR使用時仍應再行檢查。

(以上使用說明亦改寫過，已消除公司內部資訊。)

 

我知道程式碼還很有優化的空間，但是與其把這個執行效率推到極致，我想還是先去做下一個工作流程的改善好了。