返回列表 上一主題 發帖

請問如何將工作表分另儲存成不同檔案

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
117  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-5-21 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
1# 跳轉到 »
發表於 2011-2-26 12:21 | 顯示全部帖子
回復 1# enoch
  1. Sub nn()
  2. fd = "E:\Test\" '目標資料夾
  3. Set d = CreateObject("Scripting.Dictionary")
  4. With Sheets("Summary")
  5. For Each a In .Range(.[A2], .[A65536].End(xlUp))
  6.    If IsEmpty(d(a.Value)) Then
  7.      d(a.Value) = a & "," & a.Offset(, 1)
  8.      Else
  9.      d(a.Value) = d(a.Value) & "," & a.Offset(, 1)
  10.    End If
  11. Next
  12. For Each ky In d.keys
  13.   sh = Split(d(ky), ",")
  14.   fs = fd & ky & ".xls"
  15.   Sheets(sh).Copy
  16.   With ActiveWorkbook
  17.   .SaveAs fs
  18.   .Close
  19.   End With
  20. Next
  21. End With
  22. End Sub
複製代碼
學海無涯_不恥下問

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
117  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-5-21 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
2#
發表於 2011-2-26 12:43 | 顯示全部帖子
回復 3# enoch
  1. Sub nn()
  2. fd = "E:\Test\" '目標資料夾
  3. Set d = CreateObject("Scripting.Dictionary")
  4. With Sheets("Summary")
  5. For Each a In .Range(.[A2], .[A65536].End(xlUp))
  6.    If IsEmpty(d(a.Value)) Then
  7.      d(a.Value) = a & "," & a.Offset(, 1)
  8.      Else
  9.      d(a.Value) = d(a.Value) & "," & a.Offset(, 1)
  10.    End If
  11. Next
  12. For Each ky In d.keys
  13.   sh = Split(d(ky), ",")
  14.   fs = fd & ky & ".xls"
  15.   Sheets(sh).Copy
  16.   With ActiveWorkbook
  17.   If Dir(fs) <> "" Then Kill fs
  18.   .SaveAs fs
  19.   .Close
  20.   End With
  21. Next
  22. End With
  23. End Sub
複製代碼
學海無涯_不恥下問

TOP

        靜思自在 : 虛空有盡．我願無窮，發願容易行願難。
返回列表 上一主題