標題: 想把sheet裡面的資料 拆成不同的檔案 [打印本頁]

---

作者: ffntldj    時間: 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    時間: 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
    
15. 
    
16. 
    
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

---

作者: ffntldj    時間: 2011-12-1 21:35

回復 2# Hsieh


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

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)