麻辣家族討論版版 - Powered by Discuz! Board

標題: 請問為什麼執VBA時，記憶體會越來越大，變成速度變慢 [打印本頁]

作者: ashin1981 時間: 2016-5-9 23:03 標題: 請問為什麼執VBA時，記憶體會越來越大，變成速度變慢

請問我有寫一個程式是下載股票的營收、每日股價、融資融眷，每日大盤指數等，類似按一個按鈕，就會去網站下載到sheet，之後在做一些處理，
其中有一些是用CSV檔讀取資料庫方式去做處理，有將rs.close關閉，一些是用execel的web功能去下載後處理，
只是不知道為什麼當我每按一次下載按紐，下載到同一個sheet的位置，也沒有在下載到新的位置，照道理不會增加excel檔案的大小，而我用"工作管理員"看excel.exe記憶體都會慢慢變大，然後執行excel就會越來越lag，用滑鼠滾輪就可以感覺到變慢，
我本來以為是"全域變數"的關係，有把大部分的全域變數改成sub裡的變數，讓他在sub程序結束，變數就釋放掉了，但後來好像也不是這個原因，
請問版主或其他大大，知道是什麼原因嗎。
每個變數最後也都會下這個指令 Set WebShtWan = Nothing,讓參考釋放記憶體，好像也沒用。
電腦系統是用win 7,excel2010，記憶體4G。

作者: ashin1981 時間: 2016-5-9 23:34

回復 1# ashin1981

補充說明:1.只要我關閉excel程式再打開，用工作管理員觀察excel.exe記憶體，就會恢復到原本的大小。
2. 我這台電腦效能不是很好，已經是至少3、4年有了吧，CPU也是用intel celeron E3400 2.6G。

作者: c_c_lai 時間: 2016-5-10 07:06

回復 2# ashin1981
此類釋疑問題，最好請上傳問題檔案，
以方便各位大大測試與檢查你程式碼
寫法哪裡有出入。

作者: stillfish00 時間: 2016-5-10 10:36

回復 1# ashin1981

一些是用execel的web功能去下載後處理

用完的Web連線有刪除嗎? (資料>連線)

作者: ashin1981 時間: 2016-5-10 11:24

以下是我下載的程式。
===========使用web下載至sheet上====================
Sub 下載每日股價Web_1()

   Dim WbSht融資融卷 As Worksheet
   Dim WebShtDailyVal As Worksheet
   Dim TwseURL_daily$
''    Dim Workday As Integer
''    Dim Response
   WorkDay = Application.Evaluate("WEEKDAY(TODAY())-1")
''
''    If Workday = 6 And flag = 0 Then
''    m = m - 1
''    m = "0" & m
''    End If
Set WbSht融資融卷 = Sheets("融資融卷")
Set WebShtDailyVal = Sheets("每日股價")

Select Case Month(Now)
Case 1, 2
   startYear = Year(Now) - 1
   startMon = 10
Case 3, 4
   startYear = Year(Now) - 1
   startMon = 11
Case Else
   startYear = Year(Now)
   startMon = Month(Now) - 4
End Select

'''If Month(Now) = 2 Then
'''
''' startYear = Year(Now) - 1
''' startMon = 10
'''ElseIf Month(Now) = 1 Then
''' startYear = Year(Now) - 1
'''    startMon = 10
'''ElseIf Month(Now) = 3 Then
''' startYear = Year(Now) - 1
'''    startMon = 11
'''Else
''' startYear = Year(Now)
''' startMon = Month(Now) - 3
'''End If
               ''http://www.twse.com.tw/ch/trading/exchange/STOCK_DAY/genpage/Report201506/201506_F3_1_8_2379.php?STK_NO=2379&myear=2015&mmon=06
               ''http://www.twse.com.tw/ch/trading/exchange/STOCK_DAY/genpage/Report201507/201507_F3_1_8_2379.php?STK_NO=2379&myear=2015&mmon=07
TwseURL_daily = "URL;http://www.twse.com.tw/ch/trading/exchange/STOCK_DAY/genpage/Report" & y & m & "/" & y & m & "_F3_1_8_" & uRng3.Text & ".php?STK_NO=" & uRng3.Text & "&myeay=" & y & "&mmon=" & m
''融資融卷URL = "URL;http://easyfun.concords.com.tw/z/zc/zcn/zcn.djhtm?a=" & uRng3.Text & "&c=2016-1-1&d=2016-2-23"
''融資融卷URL = "URL;http://easyfun.concords.com.tw/z/zc/zcn/zcn.djhtm?a=" & uRng3.Text & "&c=" & Year(Now) & "-" & Month(Now) - 1 & "-" & Day(Now) - 20 & "&d=" & Year(Now) & "-" & Month(Now) & "-" & Day(Now)
  融資融卷URL = "URL;http://easyfun.concords.com.tw/z/zc/zcn/zcn.djhtm?a=" & uRng3.Text & "&c=" & startYear & "-" & startMon & "-" & 1 & "&d=" & Year(Now) & "-" & Month(Now) & "-" & Day(Now)
               ''http://easyfun.concords.com.tw/z/zc/zcn/zcn.djhtm?a=2379&c=2016-1-24&d=2016-2-24
               ''http://easyfun.concords.com.tw/z/zc/zcn/zcn.djhtm?a=1101&c=2016-1-23&d=2016-2-23
''TwseURL_daily = "URL;http://www.twse.com.tw/ch/trading/exchange/STOCK_DAY/genpage/Report" & y & "07" & "/" & y & "07" & "_F3_1_8_" & uRng3.Text & ".php?STK_NO=" & uRng3.Text & "&myeay=" & y & "&mmon=" & m
''TwseURL_daily = "URL;http://www.twse.com.tw/ch/trading/exchange/STOCK_DAY/genpage/Report" & y & m "/" & y & m "_F3_1_8_" & uRng3.Text ".php?STK_NO=" &uRng3.Text "&myeay=" &y "&mmon=" &m
Application.EnableCancelKey = xlErrorHandler

WebShtDailyVal.Cells.Clear

If flag = False Then
WbSht融資融卷.Cells.Clear
End If

ErrNo = 0
On Error GoTo 101

With WebShtDailyVal.QueryTables.Add(Connection:= _
      TwseURL_daily, Destination:=WebShtDailyVal.[A1])
      ''.Name = "201507_F3_1_8_2379.php?STK_NO=2379&myear=2015&mmon=07_2"
      .FieldNames = True
      .RowNumbers = False
      .FillAdjacentFormulas = False
      .PreserveFormatting = True
      .RefreshOnFileOpen = False
      .BackgroundQuery = True
      .RefreshStyle = xlInsertDeleteCells
      .SavePassword = False
      .SaveData = True
      .AdjustColumnWidth = True
      .RefreshPeriod = 0
      .WebSelectionType = xlSpecifiedTables
      .WebFormatting = xlWebFormattingNone
      .WebTables = "8"
      .WebPreFormattedTextToColumns = True
      .WebConsecutiveDelimitersAsOne = True
      .WebSingleBlockTextImport = False
      .WebDisableDateRecognition = False
      .WebDisableRedirections = False
      .Refresh BackgroundQuery:=False
End With

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''融資融卷下載開始'''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If flag = False Then

      With WbSht融資融卷.QueryTables.Add(Connection:= _
         融資融卷URL, Destination:=WbSht融資融卷.[B4])
         .Name = "zcn.djhtm?a=1101&c=2016-1-23&d=2016-2-23"
         .FieldNames = True
         .RowNumbers = False
         .FillAdjacentFormulas = False
         .PreserveFormatting = True
         .RefreshOnFileOpen = False
         .BackgroundQuery = True
         .RefreshStyle = xlInsertDeleteCells
         .SavePassword = False
         .SaveData = True
         .AdjustColumnWidth = True
         .RefreshPeriod = 0
         .WebSelectionType = xlSpecifiedTables
         .WebFormatting = xlWebFormattingNone
         .WebTables = "2"
         .WebPreFormattedTextToColumns = True
         .WebConsecutiveDelimitersAsOne = True
         .WebSingleBlockTextImport = False
         .WebDisableDateRecognition = False
         .WebDisableRedirections = False
         .Refresh BackgroundQuery:=False
      End With

End If
''Exit Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''融資融卷下載結束'''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

101: ErrNo = Err.Number

If ErrNo = 1004 Then

Exit Sub
m = m - 1
If m = 0 And d = "01" Or WorkDay = 6 Or WorkDay = 0 Then
      m = 12
      y = y - 1
Else
      m = "0" & m
End If
Call 下載每日股價Web_1

End If

If flag = 1 Then
Call 載入每日股價和大盤指數和成交量和三大法人和融資卷
End If

Set WbSht融資融卷 = Nothing
Set WebShtDailyVal = Nothing

End Sub

作者: ashin1981 時間: 2016-5-10 11:41

以下是用讀取CSV檔方式下載至sheet，
目前確定是用web方式會讓記憶體變大。
===========使用CSV讀檔下載至sheet上====================

Sub 下載每月營收_CSV()

year1 = 2008
month1 = "01"
Row = 6
col = 8

Dim F As Boolean
Set WebSht1 = Sheets("歷年營收")
Set rs = CreateObject("ADODB.Recordset")
s1 = uRng3.Text

Do While year1 <= Year(Date)

month1 = "01"
strcon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbookPath & "\每年營收\" & year1 & "\;" _
& "Extended Properties=""text;HDR=Yes;FMT=Delimited"";"

For I2 = 1 To 12 Step 1

''strSQL = "SELECT * FROM 20150301.csv WHERE 證券代號 LIKE '%" & s1 & "%'"

s = ThisWorkbookPath & "\每年營收\" & year1 & "\" & year1 & month1 & ".csv"
F = CreateObject("Scripting.FileSystemObject").FileExists(s)
If F = True Then
      strSQL = "SELECT * FROM " & year1 & month1 & ".csv WHERE 公司 LIKE '%" & s1 & "%'"
Else
      month1 = month1 + 1
      If month1 < 10 Then
         month1 = "0" & month1
      End If

      GoTo a:
End If

rs.Open strSQL, strcon, 3, 3

If rs.BOF And rs.EOF Then

rs.Close
month1 = month1 + 1

If I2 = 12 Then
year1 = year1 + 1
''count = count + 1
End If

If month1 < 10 Then
month1 = "0" & month1
End If
GoTo a:

End If

''rs.MoveFirst

Do


Row = (year1 - 2008) * (6 + AddSmallRow) + 1
col = month1 + 7 + 3 + AddCol
On Error Resume Next
''On Error GoTo Handler
uRng3(Row, col) = rs("本年度本月")
uRng3(Row + 1, col) = (uRng3(Row, col) - rs("上年度本月")) / rs("上年度本月")


rs.MoveNext
Loop Until rs.EOF

month1 = month1 + 1

If month1 < 10 Then
month1 = "0" & month1
End If

rs.Close

a: Next I2

year1 = year1 + 1
''count = count + 1
''rs.Close

Loop

Set rs = Nothing '釋放物件變數
Set WebSht1 = Nothing

Handler: Exit Sub

End Sub

作者: stillfish00 時間: 2016-5-10 17:21

回復 5# ashin1981
建議有用到 QueryTables 的地方
都在 .Refresh BackgroundQuery:=False
的下方多一行 .Delete 來刪除連線

作者: ashin1981 時間: 2016-5-10 19:02

謝謝S大

加.DELETE情況有比較好一點，另剛剛執行讀取CSV檔方式，一執行記憶體也會變大，比web方式記憶體會變大較多，是有哪裡漏掉嗎。

作者: ashin1981 時間: 2016-5-10 19:43

s大 !

看起來加上.delete以後好很多，執行久了滑鼠滾輪也不會變很慢，剩下我自己在解決，有問題再上來問謝謝。

作者: Qektyyrwp 時間: 2016-6-2 23:21

回復 7# stillfish00

請問我有一段程式如下
Range("表格_來自_mes14g_的查詢1013518725055[[#Headers],[LOT_ID]]").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False

delete要怎麼寫進去，拜託大大解惑

作者: ashin1981 時間: 2016-6-9 10:13

With WebShtYah.QueryTables.Add(Connection:=YahooURL, Destination:=WebShtYah.[A1])
      .AdjustColumnWidth = False
      .WebSelectionType = xlAllTables
      .WebFormatting = xlWebFormattingNone
      .WebPreFormattedTextToColumns = True
      .WebConsecutiveDelimitersAsOne = True
      .WebSingleBlockTextImport = False
      .WebDisableDateRecognition = False
      .Refresh BackgroundQuery:=False
   .Delete
End With

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