12
返回列表 上一主題 發帖

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

sasho

帖子
49 
主題
18 
精華
0 
積分
154 
點名
0  
作業系統
windows 
軟體版本
XP 
閱讀權限
20 
性別
男 
註冊時間
2010-6-16 
最後登錄
2024-8-5 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2014-6-7 01:53 | 只看該作者

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

各位前輩大家好,

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

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

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

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2014-6-7 06:43 | 只看該作者
本帖最後由 GBKEE 於 2014-6-21 05:18 編輯

回復 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
3#
發表於 2014-6-7 07:01 | 只看該作者
本帖最後由 c_c_lai 於 2014-6-7 07:06 編輯
各位前輩大家好,

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

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

TOP

sasho

帖子
49 
主題
18 
精華
0 
積分
154 
點名
0  
作業系統
windows 
軟體版本
XP 
閱讀權限
20 
性別
男 
註冊時間
2010-6-16 
最後登錄
2024-8-5 
4#
發表於 2014-6-16 18:12 | 只看該作者
本帖最後由 sasho 於 2014-6-16 18:16 編輯

回復 2# GBKEE

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

  3. Dim xlSheet As Excel.Worksheet
  4. Set xlSheet = Sheets("Temp")

  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

  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

  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

  31.      If Err.Number = 0 Then
  32.          Application.DisplayAlerts = True
  33.          Exit Sub
  34.      End If
  35. Loop

  37. 儲存CSV DownloadDate,id
  38. End Sub

  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)

  55.     On Error Resume Next
  56.     Kill CSVfile
  57.     On Error GoTo 0

  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

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
5#
發表於 2014-6-16 19:42 | 只看該作者
回復 4# sasho
我會先把呼叫
  1. 儲存CSV DownloadDate,id
複製代碼
改為
  1. t = timer
  2. 儲存CSV DownloadDate,id
  3. debug.print timer-t
複製代碼
先觀察確認 時間變長的地方 是在 存檔這部分。

TOP

sasho

帖子
49 
主題
18 
精華
0 
積分
154 
點名
0  
作業系統
windows 
軟體版本
XP 
閱讀權限
20 
性別
男 
註冊時間
2010-6-16 
最後登錄
2024-8-5 
6#
發表於 2014-6-16 23:02 | 只看該作者
回復 5# stillfish00

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

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

懇請各位大大解救一下

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
7#
發表於 2014-6-17 09:55 | 只看該作者
回復 7# GBKEE
Hi 版大，
我不曉得是不是EXCEL版本差異，
我在Excel2010中，刪除QueryTable物件就會直接刪除Names中的項目了。

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
8#
發表於 2014-6-17 14:08 | 只看該作者
本帖最後由 stillfish00 於 2014-6-17 14:09 編輯

回復 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
複製代碼

TOP

sasho

帖子
49 
主題
18 
精華
0 
積分
154 
點名
0  
作業系統
windows 
軟體版本
XP 
閱讀權限
20 
性別
男 
註冊時間
2010-6-16 
最後登錄
2024-8-5 
9#
發表於 2014-6-17 17:16 | 只看該作者
回復 8# stillfish00

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

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

感謝

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
10#
發表於 2014-6-18 06:17 | 只看該作者
回復 9# sasho

參考 這裡
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 並非有錢魷是快樂，問心無愧心最安。
12
返回列表 上一主題