返回列表 上一主題 發帖

想把sheet裡面的資料 拆成不同的檔案

ffntldj

帖子
26 
主題
6 
精華
0 
積分
33 
點名
0  
作業系統
XP 
軟體版本
OFFICE2003 
閱讀權限
10 
性別
男 
註冊時間
2011-7-19 
最後登錄
2013-5-13 

論壇贊助勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2011-12-1 20:16 | 只看該作者

想把sheet裡面的資料 拆成不同的檔案

先前的問題 我利用google 和之前在這學到的知識 已經靠自己解了
現在有兩個新的問題爬文查不到 想請高手幫個忙謝謝

1 .可否用vba去讀到某個資料夾裡面*.xls 的數量(就是有幾個檔案)
2. 假設檔案開起後如下,往下的資料有很多筆(無法估計),希望能做到30筆資料為一個單位拆開,最後不滿30筆也拆成一個檔案
  檔名分別為原始檔案檔名加上-1, -2,-3,也就是XXX-1.xls,XXX-2.xls,XXX-3.xls ....

例:
     1   a   a1
       2   b   b1
     3   c   c1
     .    .     .
       .    .    .   
      31  aa   aa1
      32   bb   bb1
      .     .      .
      .     .      .

      61   aaa  aaa1
      62    bbb  bbb1
  
謝謝 感激不盡
收藏 分享

Hsieh

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

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
2#
發表於 2011-12-1 21:20 | 只看該作者
  1. Sub 分檔另存()
  2. Set ab = ThisWorkbook
  3. Set sh = ActiveSheet
  4. For i = 1 To sh.[A65536].End(xlUp).Row Step 30
  5. With Sheets.Add
  6.    sh.Cells(i, 1).Resize(30, 3).Copy .[A1]
  7.    .Move
  8.    With ActiveWorkbook
  9.    n = n + 1
  10.    .SaveAs Replace(ab.FullName, ".xls", "-" & n & ".xls") '儲存檔案
  11.    .Close 0
  12.    End With
  13. End With
  14. Next


  17. End Sub
  18. Sub 檔案數量()
  19. fs = Dir("E:\*.xls") '搜尋目錄
  20. Do Until fs = ""
  21.    cnt = cnt + 1
  22.    fs = Dir
  23. Loop
  24. MsgBox "搜尋到" & cnt & "個檔案"
  25. End Sub
複製代碼
回復 1# ffntldj
學海無涯_不恥下問

TOP

ffntldj

帖子
26 
主題
6 
精華
0 
積分
33 
點名
0  
作業系統
XP 
軟體版本
OFFICE2003 
閱讀權限
10 
性別
男 
註冊時間
2011-7-19 
最後登錄
2013-5-13 

論壇贊助勳章
3#
發表於 2011-12-1 21:35 | 只看該作者
回復 2# Hsieh


    版主 謝謝你 感激不盡 明天試試看

TOP

        靜思自在 : 信心、毅力、勇氣三者具備，則天下沒有做不成的事。
返回列表 上一主題