帖子: 49
主題: 18
精華: 0
積分: 154
點名: 0
作業系統: windows
軟體版本: XP
閱讀權限: 20
性別: 男
註冊時間: 2010-6-16
最後登錄: 2015-10-17

1^# 跳轉到 » 倒序看帖

字體大小: tT

發表於 2014-6-7 01:53 | 只看該作者

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

各位前輩大家好,

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

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

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

樓主熱帖

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 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

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

複製代碼

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

TOP

c_c_lai

博士班 Rank: 6 Rank: 6

帖子: 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

中學生 Rank: 2

帖子: 49
主題: 18
精華: 0
積分: 154
點名: 0
作業系統: windows
軟體版本: XP
閱讀權限: 20
性別: 男
註冊時間: 2010-6-16
最後登錄: 2015-10-17

4^#

發表於 2014-6-16 18:12 | 只看該作者

本帖最後由 sasho 於 2014-6-16 18:16 編輯

回復 2# GBKEE

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

Sub 取得資料(strURL As String, Table As String)
Dim xlSheet As Excel.Worksheet
Set xlSheet = Sheets("Temp")
Do
Application.DisplayAlerts = False
With xlSheet.QueryTables.Add("URL;" & strURL, xlSheet.Cells(1, 1))
.WebFormatting = xlWebFormattingNone
.WebSelectionType = xlSpecifiedTables
.WebTables = Table
.BackgroundQuery = False
On Error Resume Next
Do
Err.Clear
.Refresh 0
If Err.Number Then
Application.Wait Now + TimeValue("00:00:01")
End If
Loop Until Err.Number = 0
.Delete
'If Err.Number <> 0 Then Err.Clear: MsgBox Err.Number '被免資料抓取不成功,而顯示訊息
On Error GoTo 0
End With
If Err.Number = 0 Then
Application.DisplayAlerts = True
Exit Sub
End If
Loop
儲存CSV DownloadDate,id
End Sub
Sub 儲存CSV(SaveDate As String, CSVname As String)
Dim TestObj As Object
Dim CSVfile As String, CSVfolder As String
Dim TestFolder As Boolean
FilePath = "D:\TSE\"
CSVfolder = FilePath & SaveDate & "\"
CSVfile = CSVfolder & CSVname & "_" & SaveDate & ".csv"
'Debug.Print CSVfile
Set TestObj = CreateObject("Scripting.FileSystemObject")
TestFolder = TestObj.FolderExists(CSVfolder)
If TestFolder = False Then TestObj.CreateFolder (CSVfolder)
On Error Resume Next
Kill CSVfile
On Error GoTo 0
Worksheets(Tempname).Copy
Application.DisplayAlerts = False
With ActiveWorkbook
.SaveAs FileName:=CSVfile, FileFormat:=xlCSV
.Close 0
End With
Application.DisplayAlerts = True
End Sub

複製代碼

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

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

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

TOP

stillfish00

大學生 Rank: 4

帖子: 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
我會先把呼叫

儲存CSV DownloadDate,id

複製代碼

改為

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

複製代碼

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

TOP

sasho

中學生 Rank: 2

帖子: 49
主題: 18
精華: 0
積分: 154
點名: 0
作業系統: windows
軟體版本: XP
閱讀權限: 20
性別: 男
註冊時間: 2010-6-16
最後登錄: 2015-10-17

6^#

發表於 2014-6-16 23:02 | 只看該作者

回復 5# stillfish00

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

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

懇請各位大大解救一下

TOP

stillfish00

大學生 Rank: 4

帖子: 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

大學生 Rank: 4

帖子: 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)
像這樣

Sub Ex()
Dim i As Integer, Rng As Range
With ActiveSheet
For i = 3 To 7 Step 2
With .QueryTables.Add("URL;http://forum.twbts.com/thread-635-1-1.html", .Cells(1, 1))
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = i & ""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.RefreshStyle = xlOverwriteCells
.Refresh BackgroundQuery:=False
Wb_Save .ResultRange, i
.Delete
End With
Next
End With
End Sub