Board logo

標題: [發問] VBA運轉停不了 [打印本頁]
作者: missbb    時間: 2015-8-6 23:48     標題: VBA運轉停不了

請問我運行這個VBA, 有30個SHEETS, 但運轉了5分鐘還沒有停頓, 是有甚麼錯誤呢? 又如何以以在完成存檔後自動關閉檔案?
請賜教!
Sub Splitbook()

Dim xPath As String
xPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each xWs In ThisWorkbook.Sheets
    xWs.Copy
    Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & xWs.Name & ".xls"
    Application.ActiveWorkbook.Close True
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
作者: mark15jill    時間: 2015-8-7 09:55

請問我運行這個VBA, 有30個SHEETS, 但運轉了5分鐘還沒有停頓, 是有甚麼錯誤呢? 又如何以以在完成存檔後自動 ...
missbb 發表於 2015-8-6 23:48



    建議 可將運作過程開啟
   然後 一次用1~2個檔案下去測試 或 用F8 一步一步看問題所在...
作者: c_c_lai    時間: 2015-8-7 10:18

請問我運行這個VBA, 有30個SHEETS, 但運轉了5分鐘還沒有停頓, 是有甚麼錯誤呢? 又如何以以在完成存檔後自動 ...
missbb 發表於 2015-8-6 23:48

一、  .Copy 範圍太抽象了，應明確告知其實際複製範圍；
二、 妳檔案尚未新增何來儲存檔案？
三、 以妳原本內容為稿底、稍予修正，請妳自行再測試看看：
  1. Sub Splitbook()
  2.     Dim xPath As String, xWs As Worksheet

  4.     xPath = Application.ActiveWorkbook.Path

  6.     Application.ScreenUpdating = False
  7.     Application.DisplayAlerts = False

  9.     For Each xWs In ThisWorkbook.Sheets
  10.         With Sheets(xWs.Name)
  11.             .UsedRange.Copy

  13.             With Workbooks.Add(1)
  14.                 .Sheets(1).Paste
  15.                 .SaveAs xPath & "\" & xWs.Name & ".xls", FileFormat:=xlExcel8
  16.                 .Close
  17.             End With
  18.         End With
  19.     Next
  20.     Application.DisplayAlerts = True
  21.     Application.ScreenUpdating = True
  22. End Sub
複製代碼
作者: jackyq    時間: 2015-8-7 10:24

一、  .Copy 範圍太抽象了，應明確告知其實際複製範圍；
二、 妳檔案尚未新增何來儲存檔案？
三、 以妳 ...
c_c_lai 發表於 2015-8-7 10:18


大大好
Copy 時自己毀新增啊
作者: mark15jill    時間: 2015-8-7 11:07

大大好
Copy 時自己毀新增啊
jackyq 發表於 2015-8-7 10:24



    copy 只是複製.. 你沒有任何 paste的指令阿..

只有複製沒有貼上 哪來的新增可言...
作者: missbb    時間: 2015-8-7 13:57

各位大大,
有勞, 很開快問題解決了.

作者: GBKEE    時間: 2015-8-7 14:35

回復 1# missbb
你的程式沒問題.
可能因有30個SHEETS的資料大, 所以會運轉了5分鐘還沒有停頓,但耐心等候會完成的.
回復 3# c_c_lai
回復 4# jackyq
回復 5# mark15jill
  1. For Each xWs In ThisWorkbook.Sheets
  2.     xWs.Copy  '工作表複製  -> 一張工作表的活頁簿. -> ActiveWorkbook
  3.     Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & xWs.Name & ".xls" '指定路徑存檔
複製代碼
作者: mark15jill    時間: 2015-8-7 15:57

回復  missbb
你的程式沒問題.
可能因有30個SHEETS的資料大, 所以會運轉了5分鐘還沒有停頓,但耐心等候會 ...
GBKEE 發表於 2015-8-7 14:35



忘記 原始資料數量多寡也會影響速度.... 哈

    受教了~ 謝謝
作者: missbb    時間: 2015-8-8 09:09

回復 7# GBKEE

多謝!會再努力!
作者: c_c_lai    時間: 2015-8-8 09:48

回復  missbb
你的程式沒問題.
可能因有30個SHEETS的資料大, 所以會運轉了5分鐘還沒有停頓,但耐心等候會 ...
GBKEE 發表於 2015-8-7 14:35

在我的Excel 2010 測試時，如果不加入 FileFormat:=xlExcel8 的話，
儲存的 xls 檔案均無法開啟 (如附圖)， 所以我才會稍加修改，謝謝您的指導！
[attach]21668[/attach]
  1. Sub Splitbook2()     '  GBKEE
  2.     Dim xPath As String, xWs As Worksheet

  4.     xPath = Application.ActiveWorkbook.Path

  6.     Application.ScreenUpdating = False
  7.     Application.DisplayAlerts = False

  9.     For Each xWs In ThisWorkbook.Sheets
  10.         xWs.Copy                          '  工作表複製   ->   一張工作表的活頁簿.  ->  ActiveWorkbook
  11.         
  12.         '  Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & xWs.Name & ".xls"     '指定路徑存檔
  13.         Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & xWs.Name & ".xls", FileFormat:=xlExcel8 '指定路徑存檔
  14.         Application.ActiveWorkbook.Close True
  15.     Next
  16.    
  17.     Application.DisplayAlerts = True
  18.     Application.ScreenUpdating = True
  19. End Sub
複製代碼
作者: missbb    時間: 2015-8-15 17:34

回復 10# c_c_lai


    多謝指導:D



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