帖子: 176
主題: 98
精華: 0
積分: 279
點名: 0
作業系統: window 7
軟體版本: office 2007
閱讀權限: 20
性別: 男
註冊時間: 2011-2-17
最後登錄: 2020-4-8

1^# 跳轉到 » 正序看帖

字體大小: tT

發表於 2011-2-26 12:01 | 只看該作者

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

請問各位高手

請問能否跟據下面資料
將有關工作表另存成個別檔案,例如:
檔案AA 包括工作表AA, sheet1, sheet2, sheet3
檔案BB 包括工作表AA, sheet4, sheet5, sheet6, sheet7, sheet8

工作表1 工作表2
AA sheet1
AA sheet2
AA sheet3
BB sheet4
BB sheet5
BB sheet6
BB sheet7
BB sheet8

請多多指教

匯出檔案.zip (14.48 KB)

樓主熱帖

dechiuan999

中學生 Rank: 2

帖子: 231
主題: 55
精華: 0
積分: 293
點名: 0
作業系統: winxp
軟體版本: office2003
閱讀權限: 20
性別: 男
來自: KEELUNG
註冊時間: 2010-7-24
最後登錄: 2018-8-28

9^#

發表於 2011-7-6 10:53 | 只看該作者

謝謝版主大大。
For Each ky In d.keys
   d( ky)    ->items
Next
For Each ky In d.items
   ky ->items
Next
dictionary真讓人著迷，
也好深奧哦！
淺顯例子也能顯示出如此變化。
真讓人受益良多。
感恩版主大大。

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

8^#

發表於 2011-7-6 08:04 | 只看該作者

回復 7# dechiuan999
For Each ky In d.keys
   d( ky)    ->items
Next
For Each ky In d.items
   ky ->items
Next

TOP

dechiuan999

中學生 Rank: 2

帖子: 231
主題: 55
精華: 0
積分: 293
點名: 0
作業系統: winxp
軟體版本: office2003
閱讀權限: 20
性別: 男
來自: KEELUNG
註冊時間: 2010-7-24
最後登錄: 2018-8-28

7^#

發表於 2011-7-6 07:02 | 只看該作者

版主大大你好：

請問為何此語法是用
For Each ky In d.keys才能取出items資料，
而為何For Each ky In d.items就無法取出資料呢？

感恩大大！

TOP

enoch

中學生 Rank: 2

帖子: 176
主題: 98
精華: 0
積分: 279
點名: 0
作業系統: window 7
軟體版本: office 2007
閱讀權限: 20
性別: 男
註冊時間: 2011-2-17
最後登錄: 2020-4-8

6^#

發表於 2011-7-5 22:13 | 只看該作者

若果同一問題,但有部份不是工作表, 而是檔案可以嗎?
例如:
檔案AA 包括工作表AA, sheet1, sheet2, book1.xls
檔案BB 包括工作表AA, sheet4, sheet5, sheet6, book2.xls, book3.xls

工作表1       工作表2
AA       sheet1
AA       sheet2
AA       book1.xls
BB       sheet4
BB       sheet5
BB       sheet6
BB       book2.xls
BB       book3.xls

TOP

enoch

中學生 Rank: 2

帖子: 176
主題: 98
精華: 0
積分: 279
點名: 0
作業系統: window 7
軟體版本: office 2007
閱讀權限: 20
性別: 男
註冊時間: 2011-2-17
最後登錄: 2020-4-8

5^#

發表於 2011-2-26 12:56 | 只看該作者

Hsieh

謝謝你,問題已解決

enoch

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

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

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

4^#

發表於 2011-2-26 12:43 | 只看該作者

回復 3# enoch

Sub nn()
fd = "E:\Test\" '目標資料夾
Set d = CreateObject("Scripting.Dictionary")
With Sheets("Summary")
For Each a In .Range(.[A2], .[A65536].End(xlUp))
If IsEmpty(d(a.Value)) Then
d(a.Value) = a & "," & a.Offset(, 1)
Else
d(a.Value) = d(a.Value) & "," & a.Offset(, 1)
End If
Next
For Each ky In d.keys
sh = Split(d(ky), ",")
fs = fd & ky & ".xls"
Sheets(sh).Copy
With ActiveWorkbook
If Dir(fs) <> "" Then Kill fs
.SaveAs fs
.Close
End With
Next
End With
End Sub

複製代碼

學海無涯_不恥下問

TOP

enoch

中學生 Rank: 2

帖子: 176
主題: 98
精華: 0
積分: 279
點名: 0
作業系統: window 7
軟體版本: office 2007
閱讀權限: 20
性別: 男
註冊時間: 2011-2-17
最後登錄: 2020-4-8

3^#

發表於 2011-2-26 12:37 | 只看該作者

Hsieh

謝謝你
但還有少少問題,
當重新執行巨集時,
因為檔已存在而出現ERROR
請問如何可以自動取代現有檔案

enoch

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

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

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

2^#

發表於 2011-2-26 12:21 | 只看該作者

回復 1# enoch

Sub nn()
fd = "E:\Test\" '目標資料夾
Set d = CreateObject("Scripting.Dictionary")
With Sheets("Summary")
For Each a In .Range(.[A2], .[A65536].End(xlUp))
If IsEmpty(d(a.Value)) Then
d(a.Value) = a & "," & a.Offset(, 1)
Else
d(a.Value) = d(a.Value) & "," & a.Offset(, 1)
End If
Next
For Each ky In d.keys
sh = Split(d(ky), ",")
fs = fd & ky & ".xls"
Sheets(sh).Copy
With ActiveWorkbook
.SaveAs fs
.Close
End With
Next
End With
End Sub

複製代碼

學海無涯_不恥下問

TOP