用迴圈抓資料越跑越慢，該如何釋放記憶體?

sasho

各位前輩大家好,

我有個程式使用迴圈及querytable.add的方式抓取外部資料(抓完會執行querytable.delete)
並在匯入資料後用worksheets.copy的方式另存，
此時程式會自動新增一個活頁簿，待存檔後再將新增的活頁簿關閉

但我發現如此一來，因為每次copy工作表時都會新增一個活頁簿
如果我的迴圈一共要抓好幾百次的資料
那就會增加好幾百個活頁簿
雖然之後會關閉，但不曉得記憶體有沒有釋放掉，因為活頁簿的編號會一直增加上去
而程式跑的速度也越來越慢....@@"

可以請各位前輩幫忙解答一下嗎? 謝謝

GBKEE

回復 1# sasho

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim i As Integer, rng As Range
   
4.     With ActiveSheet
   
5.         If .QueryTables.Count = 0 Then .QueryTables.Add "URL;", .[a1]
   
6.         For i = 3 To 17 Step 2
   
7.             '迴圈中ㄧ直的 querytable.add 檔案會胖起來,導致程式的速度越來越慢
   
8.             With .QueryTables(1)
   
9.                 .Connection = "URL;http://forum.twbts.com/thread-635-1-1.html"
   
10.                 .WebSelectionType = xlSpecifiedTables
    
11.                 .WebFormatting = xlWebFormattingNone
    
12.                 .WebTables = i & ""
    
13.                 .WebPreFormattedTextToColumns = True
    
14.                 .WebConsecutiveDelimitersAsOne = True
    
15.                 .WebSingleBlockTextImport = False
    
16.                 .WebDisableDateRecognition = False
    
17.                 .WebDisableRedirections = False
    
18.                 .Refresh BackgroundQuery:=False
    
19.                 Wb_Save .ResultRange, i
    
20.             End With
    
21.         Next
    
22.    End With
    
23. End Sub
    
24. Private Sub Wb_Save(Rng As Range, i As Integer)  '副程式:新增活頁簿,存檔
    
25.     With Workbooks.Add(1)
    
26.         Rng.Copy .Sheets(1).[a1]
    
27.         .Close True, "d:\test_" & i & ".xls"
    
28.         '關閉存檔
    
29.     End With
    
30. End Sub

複製代碼

c_c_lai

各位前輩大家好,

我有個程式使用迴圈及querytable.add的方式抓取外部資料(抓完會執行querytable.delete) ...
sasho 發表於 2014-6-7 01:53

依你描述作業過程，勢必會愈來愈慢，EXCEL 本身在執行時會另外產生一工作站暫存檔，
它會隨時動態地將你所有異動狀態紀錄於此檔案內，它承擔了所有驗對、變動、刪除、
新增以及記憶體的耗用，於檔案不斷增大時，其負荷亦跟隨之增大。
解決方法可將須不斷增加的檔案存於另一工作檔，不用時則隨時將它關閉，如此作業
再來評估成效。就如上 GBKEE 版大所展示的程式碼一樣，處理完畢即隨手將它關閉。

sasho

回復 2# GBKEE

感謝G大的指點，但可能我表達的不是很清楚，所以讓大家誤會我的問題了
跟G大所示範的一樣，程式再匯入網頁資料後都會另存成一個CSV檔案並關閉，
同時，將所新增的querytable delete掉，程式碼如下：

1. Sub 取得資料(strURL As String, Table As String)
   
2. 
   
3. Dim xlSheet As Excel.Worksheet
   
4. Set xlSheet = Sheets("Temp")
   
5. 
   
6. Do
   
7.     Application.DisplayAlerts = False
   
8.      With xlSheet.QueryTables.Add("URL;" & strURL, xlSheet.Cells(1, 1))
   
9.          .WebFormatting = xlWebFormattingNone
   
10.          .WebSelectionType = xlSpecifiedTables
    
11.          .WebTables = Table
    
12.          .BackgroundQuery = False
    
13. 
    
14.          On Error Resume Next
    
15.          Do
    
16.              Err.Clear
    
17.              .Refresh 0
    
18.             
    
19.              If Err.Number Then
    
20.                  Application.Wait Now + TimeValue("00:00:01")
    
21.              End If
    
22. 
    
23.          Loop Until Err.Number = 0
    
24.          
    
25.          .Delete
    
26.          'If Err.Number <> 0 Then Err.Clear: MsgBox Err.Number    '被免資料抓取不成功,而顯示訊息
    
27.          
    
28.          On Error GoTo 0
    
29.      End With
    
30. 
    
31.      If Err.Number = 0 Then
    
32.          Application.DisplayAlerts = True
    
33.          Exit Sub
    
34.      End If
    
35. Loop
    
36. 
    
37. 儲存CSV DownloadDate,id
    
38. End Sub
    
39. 
    
40. Sub 儲存CSV(SaveDate As String, CSVname As String)
    
41.    
    
42. Dim TestObj As Object
    
43. Dim CSVfile As String, CSVfolder As String
    
44. Dim TestFolder As Boolean
    
45.    
    
46.     FilePath = "D:\TSE\"
    
47.     CSVfolder = FilePath & SaveDate & "\"
    
48.     CSVfile = CSVfolder & CSVname & "_" & SaveDate & ".csv"
    
49.     'Debug.Print CSVfile
    
50.    
    
51.     Set TestObj = CreateObject("Scripting.FileSystemObject")
    
52.     TestFolder = TestObj.FolderExists(CSVfolder)
    
53.     If TestFolder = False Then TestObj.CreateFolder (CSVfolder)
    
54. 
    
55.     On Error Resume Next
    
56.     Kill CSVfile
    
57.     On Error GoTo 0
    
58. 
    
59.     Worksheets(Tempname).Copy
    
60.     Application.DisplayAlerts = False
    
61.     With ActiveWorkbook
    
62.         .SaveAs FileName:=CSVfile, FileFormat:=xlCSV
    
63.         .Close 0
    
64.     End With
    
65.     Application.DisplayAlerts = True
    
66.    
    
67. End Sub

複製代碼

我的問題是在於，由於我用迴圈一共要抓幾百筆的資料
我從儲存下來的檔案最後變動時間觀察，發現一開始可能一秒鐘可以抓五到六個檔案
但到後面，可能一秒鐘就只能抓兩個檔案，檔案大小都差不多
一直不知道為什麼速度會越來越慢，每抓完一筆檔案就執行一次 doevents
所以應該不至於造成CPU資源被吃光
唯一能想到的就是，每次另存一個檔案，就會新開一個活頁簿
比方說，活頁簿1、活頁簿2、活頁簿3....到最後的活頁簿999
雖然把資料複製過去後、另存新檔後該活頁簿就會關閉，但EXCEL好像還是會占用到記憶體資源   
是不是因為這樣才導致速度越來越慢呢?

還是說，是因為我複製的方式不正確才會導致記憶體增加的呢?
G大跟我的差別在於，匯入資料後G大是workbook.add然後複製匯入的range
而我則是直接將整個worksheet copy
不曉得這兩者的方式有差嗎

謝謝各位前輩指點 m(_ _)m

stillfish00

回復 4# sasho
我會先把呼叫

1. 儲存CSV DownloadDate,id

複製代碼

改為

1. t = timer
   
2. 儲存CSV DownloadDate,id
   
3. debug.print timer-t

複製代碼

先觀察確認 時間變長的地方 是在 存檔這部分。

sasho

回復 5# stillfish00

時間變長的部分，應該是在匯入網頁資料所花的時間
一開始匯入很順，但越到後面就越卡，不知道是什麼原因

同時我有觀察EXCEL在工作管理員中占用的記憶體容量
從程式執行前到程式執行後，整個記憶體增加了不少
一樣也是不知道原因

懇請各位大大解救一下

stillfish00

回復 7# GBKEE
Hi 版大，
我不曉得是不是EXCEL版本差異，
我在Excel2010中，刪除QueryTable物件就會直接刪除Names中的項目了。

stillfish00

回復 9# GBKEE
QueryTables.Delete 只會刪除連線和定義的名稱，不會刪除取得的資料

而樓主用迴圈執行多筆時資料會一直往右累積增加
這也許可以改RefreshStyle為xlOverwriteCells來防止(預設是xlInsertDeleteCells)
像這樣

1. Sub Ex()
   
2.     Dim i As Integer, Rng As Range
   
3.     With ActiveSheet
   
4.         For i = 3 To 7 Step 2
   
5.             With .QueryTables.Add("URL;http://forum.twbts.com/thread-635-1-1.html", .Cells(1, 1))
   
6.                 .WebSelectionType = xlSpecifiedTables
   
7.                 .WebFormatting = xlWebFormattingNone
   
8.                 .WebTables = i & ""
   
9.                 .WebPreFormattedTextToColumns = True
   
10.                 .WebConsecutiveDelimitersAsOne = True
    
11.                 .WebSingleBlockTextImport = False
    
12.                 .WebDisableDateRecognition = False
    
13.                 .WebDisableRedirections = False
    
14.                
    
15.                 .RefreshStyle = xlOverwriteCells
    
16.                 .Refresh BackgroundQuery:=False
    
17.                 Wb_Save .ResultRange, i
    
18.                
    
19.                 .Delete
    
20.             End With
    
21.         Next
    
22.    End With
    
23. End Sub

複製代碼

sasho

回復 8# stillfish00

我使用的是EXCEL 2010，執行QueryTables.delete並不會將匯入資料刪除，只會把連線刪除而已

另外，我在另存匯入資料後，也會在執行worksheets.cells.delete，所以資料是不會向右累積的

感謝

GBKEE

回復 9# sasho

參考 這裡