返回列表 上一主題 發帖

[發問] (已解決)如何將多個檔案彙總至一個檔案中(分季)

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
0  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2024-11-14 
1# 跳轉到 »
發表於 2011-6-7 00:29 | 顯示全部帖子
本帖最後由 luhpro 於 2011-6-7 00:35 編輯

依你的需求來看基本上我們要做的就是 :
1. 找到需要處理的檔案
2. 建立新的(或找到這個) Excel WorkBook
3. 將該季三個月的檔案中的Sheet 新增(Copy)到這個 WorkBook
4. 給定該季的檔案名稱並存檔後關閉
5. 繼續處理下一個檔案

第 1. 個步驟可以用 Dir 指令來達成.
第 2 ~ 4 的步驟我大概列出一些步驟給你參考 :
  1.   Dim sSouFile$, sTarFile$
  2.   Dim shSou, shTar

  4.   '執行前請先在工作目錄下建立一個 Ans 目錄, 用來存放轉換過後的檔案, 可避免新建的檔案也被 Dir 納入處理造成錯誤結果
  5.   
  6.   '這裡使用 dir 指令找到需要處理的檔案並開啟它, 焦點設在要 Copy 的 Sheet
  7.   '以下假設該檔案名稱已經賦予給 sSouFile 了, 即 sSouFile = "200101.xls" 之類
  8.   'sSouFile = "200101.xls"

  10.   Application.DisplayAlerts = False
  11.   
  12.   Set shSou = Sheets(1) ' 假設 200101.xls 檔案中要 Copy 的是 Sheet(1)
  13.   With shSou
  14.     sTarFile = Left(sSouFile, 4) & Right("0" & Int((Val(Mid(sSouFile, 5, 2)) - 1) / 3) + 1, 2) ' 轉換成季檔名
  15.    sTarFile = ThisWorkbook.Path & "\Ans\" & sTarFile & ".xls"
  16.       
  17.     .Copy
  18.       
  19.     Set shTar = ActiveWorkbook.ActiveSheet
  20.    
  21.     With shTar.Parent
  22.       shTar.Name = Mid(sSouFile, 5, 2)
  23.       .SaveAs Filename:=sTarFile
  24.       .Close
  25.     End With
  26.   End With
  27.     Application.DisplayAlerts = True
複製代碼
上述程式還有一個問題就是每個檔案都只有一個 Sheet,
因為怎麼把 Sheet 新增到某個檔案中的某個Sheet前(或後)面,
這點我還沒測試出來.

TOP

        靜思自在 : 人要自愛，才能愛普天下的人。
返回列表 上一主題