12
返回列表 上一主題 發帖

[發問] 程式執行速度越來越慢

bulletin

帖子
27 
主題
7 
精華
0 
積分
38 
點名
0  
作業系統
Win 7 
軟體版本
Office 2007 
閱讀權限
10 
性別
男 
註冊時間
2012-9-19 
最後登錄
2014-2-18 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2014-2-5 19:12 | 只看該作者

[發問] 程式執行速度越來越慢

本帖最後由 bulletin 於 2014-2-5 19:14 編輯

各位前輩好
小弟初學，還不知道要怎麼處理資料庫
因此寫了一個程式抓取券商已整理好的財報
程式可以執行
但是發現幾個問題

1. 若沒有另存新檔，資料可抓取，但是隨著時間過去，excel會越變越慢, 從每筆約1秒慢慢變成1分鐘....
     請問這有什麼好方法可以改善嗎？
     先把財報抓下來之後再做資料篩選並另存是否是較好的選擇？
     
註：沒存新檔就是程式最下方的這幾行刪除

            Sheets(Array("CFSQ", "ISQ", "BSQ")).Copy
            ActiveWorkbook.SaveAs Filename:= _
              "C:\Users\user\Documents\KT\投資理財\Excel分析模組\" & stockid & "季報.xlsx", FileFormat:= _
               xlOpenXMLWorkbook, CreateBackup:=False
                       
            Application.DisplayAlerts = True
            Windows(stockid & "季報.xlsx").Close

2. 有另存新檔的程式如下, 平均每筆都需花費1~2分鐘才能完成
     請問程式碼有什麼地方可以改善嗎？
     還是這樣抓取資料天生就註定速度會隨著記憶體空間佔據而逐漸變慢？
     有請各位前輩協助
  1. Private Sub CommandButton1_Click()

  3.     Dim StartTime
  4.     StartTime = Timer
  5.     Application.ScreenUpdating = False

  7.     For i = 1 To 100
  8.         
  9.         Dim stockid
  10.         stockid = Range("A" & i).Value
  11.    
  12.     Application.Wait Now + TimeValue("00:00:01")

  14.        '現金流量表季報
  15.        With Sheets("CFSQ")
  16.            .Rows("1:64").ClearContents
  17.            With .QueryTables.Add(Connection:= _
  18.                "URL;http://dj.mybank.com.tw/z/zc/zc3/zc3_" & stockid & ".djhtm", Destination:=.Range( _
  19.                "$A$1"))
  20.                .Name = "zc3_2002.djhtm"
  21.                .FieldNames = True
  22.                .RowNumbers = False
  23.                .FillAdjacentFormulas = False
  24.                .PreserveFormatting = True
  25.                .RefreshOnFileOpen = False
  26.                .BackgroundQuery = True
  27.                .RefreshStyle = xlInsertDeleteCells
  28.                .SavePassword = False
  29.                .SaveData = True
  30.                .AdjustColumnWidth = True
  31.                .RefreshPeriod = 0
  32.                .WebSelectionType = xlSpecifiedTables
  33.                .WebFormatting = xlWebFormattingNone
  34.                .WebTables = "3"
  35.                .WebPreFormattedTextToColumns = True
  36.                .WebConsecutiveDelimitersAsOne = True
  37.                .WebSingleBlockTextImport = False
  38.                .WebDisableDateRecognition = False
  39.                .WebDisableRedirections = False
  40.                .Refresh BackgroundQuery:=False
  41.            End With
  42.        End With
  43.       
  44.       '損益表季報
  45.        With Sheets("ISQ")
  46.            .Rows("1:64").ClearContents
  47.            With .QueryTables.Add(Connection:= _
  48.                "URL;http://dj.mybank.com.tw/z/zc/zcq/zcq_" & stockid & ".asp.htm", Destination:=.Range( _
  49.                "$A$1"))
  50.                .Name = "zcq_2002.asp"
  51.                .FieldNames = True
  52.                .RowNumbers = False
  53.                .FillAdjacentFormulas = False
  54.                .PreserveFormatting = True
  55.                .RefreshOnFileOpen = False
  56.                .BackgroundQuery = True
  57.                .RefreshStyle = xlInsertDeleteCells
  58.                .SavePassword = False
  59.                .SaveData = True
  60.                .AdjustColumnWidth = True
  61.                .RefreshPeriod = 0
  62.                .WebSelectionType = xlSpecifiedTables
  63.                .WebFormatting = xlWebFormattingNone
  64.                .WebTables = "3"
  65.                .WebPreFormattedTextToColumns = True
  66.                .WebConsecutiveDelimitersAsOne = True
  67.                .WebSingleBlockTextImport = False
  68.                .WebDisableDateRecognition = False
  69.                .WebDisableRedirections = False
  70.                .Refresh BackgroundQuery:=False
  71.            End With
  72.        End With
  73.       
  74.       '資產負債表季報
  75.        With Sheets("BSQ")
  76.            .Rows("1:64").ClearContents
  77.            With .QueryTables.Add(Connection:= _
  78.                "URL;http://dj.mybank.com.tw/z/zc/zcp/zcpa/zcpa_" & stockid & ".asp.htm", Destination:= _
  79.                .Range("$A$1"))
  80.                .Name = "zcpa_2002.asp"
  81.                .FieldNames = True
  82.                .RowNumbers = False
  83.                .FillAdjacentFormulas = False
  84.                .PreserveFormatting = True
  85.                .RefreshOnFileOpen = False
  86.                .BackgroundQuery = True
  87.                .RefreshStyle = xlInsertDeleteCells
  88.                .SavePassword = False
  89.                .SaveData = True
  90.                .AdjustColumnWidth = True
  91.                .RefreshPeriod = 0
  92.                .WebSelectionType = xlSpecifiedTables
  93.                .WebFormatting = xlWebFormattingNone
  94.                .WebTables = """oMainTable"""
  95.                .WebPreFormattedTextToColumns = True
  96.                .WebConsecutiveDelimitersAsOne = True
  97.                .WebSingleBlockTextImport = False
  98.                .WebDisableDateRecognition = False
  99.                .WebDisableRedirections = False
  100.                .Refresh BackgroundQuery:=False
  101.            End With
  102.        End With
  103.       
  104.             Application.DisplayAlerts = False '存檔時直接覆蓋原有檔案
  105.       
  106.         '另存新檔
  107.             Sheets(Array("CFSQ", "ISQ", "BSQ")).Copy
  108.             ActiveWorkbook.SaveAs Filename:= _
  109.               "C:\Users\user\Documents\KT\投資理財\Excel分析模組\" & stockid & "季報.xlsx", FileFormat:= _
  110.                xlOpenXMLWorkbook, CreateBackup:=False
  111.                        
  112.             Application.DisplayAlerts = True
  113.             Windows(stockid & "季報.xlsx").Close
  114.                
  115.     Next i

  117.    Application.ScreenUpdating = True
  118.    EndTime = Timer
  119.    MsgBox "本次下載共花費：" & EndTime - StartTime & "秒"
  120.       
  121.    
  122. End Sub
複製代碼
收藏 分享

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-2-5 20:11 | 只看該作者
回復 1# bulletin
工作表一直的 QueryTables.Add 新增Web查詢,檔案越來越龐大,拖慢程式的速度
  1. Option Explicit
  2. Sub DELETE_QueryTables()  '僅須執行一次清除所有QueryTable
  3.     Dim SH As Worksheet, Q As QueryTable
  4.     For Each SH In Sheets           '活頁簿的工作表集合物件
  5.         For Each Q In SH.QueryTables
  6.             Names(Q.Name).Delete    '刪除 定義名稱
  7.             Q.Delete                '刪除 QueryTable
  8.         Next
  9.     Next
  10. End Sub

  12. Sub Ex()
  13.     Dim stockid
  14.     stockid = 2303
  15.     With Sheets("CFSQ")
  16.         .Rows("1:64").ClearContents
  17.         If .QueryTables.Count > 1 Then
  18.             .QueryTables(1).Connection = "URL;http://dj.mybank.com.tw/z/zc/zc3/zc3_" & stockid & ".djhtm"
  19.         Else  '沒有QueryTable時新增
  20.              .QueryTables.Add Connection:="URL;http://dj.mybank.com.tw/z/zc/zc3/zc3_" & stockid & ".djhtm", Destination:=.Range("$A$1")
  21.         End If
  22.         With .QueryTables(1)  '不再新增
  23.             .AdjustColumnWidth = True
  24.             .RefreshPeriod = 0
  25.             .WebSelectionType = xlSpecifiedTables
  26.             .WebFormatting = xlWebFormattingNone
  27.             .WebTables = "3"
  28.             .WebPreFormattedTextToColumns = True
  29.             .WebConsecutiveDelimitersAsOne = True
  30.             .Refresh BackgroundQuery:=False
  31.         End With
  32.     End With
  33. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

bulletin

帖子
27 
主題
7 
精華
0 
積分
38 
點名
0  
作業系統
Win 7 
軟體版本
Office 2007 
閱讀權限
10 
性別
男 
註冊時間
2012-9-19 
最後登錄
2014-2-18 
3#
發表於 2014-2-5 22:57 | 只看該作者
回復 2# GBKEE

多謝GBKEE版主回復
我的程式放在附件中

請問您回覆的內容該怎麼使用...
我還不會使用module
直接放到一個新的檔案中執行也發生問題
不知道該如何使用它
很抱歉造成您的困擾~

VBA測試專用.zip (289.89 KB)

TOP

GBKEE

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

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

回復 3# bulletin
Sub DELETE_QueryTables()  複製在何模組上,執行一次可清除所有工作表上QueryTable
  1. Option Explicit
  2. Private Sub CommandButton1_Click()
  3.     Dim StartTime, LastRow
  4.     StartTime = Timer
  5.     Application.ScreenUpdating = False
  6.     LastRow = Sheets("sheet1").Range("A2").End(xlDown).Row '找出最後一筆資料
  7.     For i = 1 To LastRow
  8.         Dim stockid
  9.         stockid = Range("A" & i).Value
  10.         Application.Wait Now + TimeValue("00:00:01")
  11.         With Sheets("CFSQ")
  12.             .Rows("1:64").ClearContents
  13.             '******************************
  14.             If .QueryTables.Count > 1 Then
  15.                 .QueryTables(1).Connection = "URL;http://dj.mybank.com.tw/z/zc/zc3/zc3_" & stockid & ".djhtm"
  16.             Else  '沒有QueryTable時新增
  17.                 .QueryTables.Add Connection:="URL;http://dj.mybank.com.tw/z/zc/zc3/zc3_" & stockid & ".djhtm", Destination:=.Range("$A$1")
  18.             End If
  19.             With .QueryTables(1)  '不再新增
  20.                 .AdjustColumnWidth = True
  21.                 .RefreshPeriod = 0
  22.                 .WebSelectionType = xlSpecifiedTables
  23.                 .WebFormatting = xlWebFormattingNone
  24.                 .WebTables = "3"
  25.                 .WebPreFormattedTextToColumns = True
  26.                 .WebConsecutiveDelimitersAsOne = True
  27.                 .Refresh BackgroundQuery:=False
  28.             End With
  29.             '******************************
  30.        End With
  31.       
  32.        With Sheets("ISQ")
  33.            .Rows("1:64").ClearContents
  34.            '套上修改 .QueryTables(1).Connection =??? .QueryTables.Add Connection=???
  35.        End With
  36.       
  37.        With Sheets("BSQ")
  38.            .Rows("1:64").ClearContents
  39.            '套上修改 .QueryTables(1).Connection =??? .QueryTables.Add Connection=???
  40.            '.WebTables = """oMainTable""" 須修改
  41.            End With
  42.        End With
  43.        '程式碼
  44.        '
  45.        '
  46.     Next
  47. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

bulletin

帖子
27 
主題
7 
精華
0 
積分
38 
點名
0  
作業系統
Win 7 
軟體版本
Office 2007 
閱讀權限
10 
性別
男 
註冊時間
2012-9-19 
最後登錄
2014-2-18 
5#
發表於 2014-2-6 11:52 | 只看該作者
回復 4# GBKEE

GBKEE版主您好
我加入您修改的程式，詳如附件
測試之後發現幾個問題

1. 尚未呼叫Delete_QueryTables前，速度差異甚大
不另存新檔：99筆資料共112秒
另存新檔：第1筆就花了121秒...
可見拖累速度是另存新檔的原因，請問有何解決之道？

2. 呼叫Delete_QueryTables，發生錯誤1004
錯誤內容如下圖

我發現錯誤內容是Q.name的地方成為"zc3_2002.djhtm_231"
不懂為何後面會多了_231這幾個字

VBA測試專用.zip (270.05 KB)
  1. Private Sub CommandButton1_Click()

  3.     Dim StartTime
  4.     StartTime = Timer
  5.     Application.ScreenUpdating = False
  6.     LastRow = Sheets("sheet1").Range("A2").End(xlDown).Row '找出最後一筆資料

  8.     For i = 2 To LastRow
  9.         
  10.         Dim stockid
  11.         stockid = Range("A" & i).Value
  12.    
  13.     Application.Wait Now + TimeValue("00:00:01")

  15.        With Sheets("CFSQ")
  16.            '.Rows("1:64").ClearContents
  17.            '******************************
  18.             If .QueryTables.Count > 1 Then
  19.                 .QueryTables(1).Connection = "URL;http://dj.mybank.com.tw/z/zc/zc3/zc3_" & stockid & ".djhtm"
  20.             Else  '沒有QueryTable時新增
  21.                 .QueryTables.Add Connection:="URL;http://dj.mybank.com.tw/z/zc/zc3/zc3_" & stockid & ".djhtm", Destination:=.Range("$A$1")
  22.             End If
  23.             With .QueryTables(1)  '不再新增
  24.                 .AdjustColumnWidth = True
  25.                 .RefreshPeriod = 0
  26.                 .WebSelectionType = xlSpecifiedTables
  27.                 .WebFormatting = xlWebFormattingNone
  28.                 .WebTables = "3"
  29.                 .WebPreFormattedTextToColumns = True
  30.                 .WebConsecutiveDelimitersAsOne = True
  31.                 .Refresh BackgroundQuery:=False
  32.             End With
  33.             '******************************
  34.        End With
  35.       
  36.        With Sheets("ISQ")
  37.            '.Rows("1:64").ClearContents
  38.            '******************************
  39.             If .QueryTables.Count > 1 Then
  40.                 .QueryTables(1).Connection = "URL;http://dj.mybank.com.tw/z/zc/zcq/zcq_" & stockid & ".asp.htm"
  41.             Else  '沒有QueryTable時新增
  42.                 .QueryTables.Add Connection:="URL;http://dj.mybank.com.tw/z/zc/zcq/zcq_" & stockid & ".asp.htm", Destination:=.Range("$A$1")
  43.             End If
  44.             With .QueryTables(1)  '不再新增
  45.                 .AdjustColumnWidth = True
  46.                 .RefreshPeriod = 0
  47.                 .WebSelectionType = xlSpecifiedTables
  48.                 .WebFormatting = xlWebFormattingNone
  49.                 .WebTables = "3"
  50.                 .WebPreFormattedTextToColumns = True
  51.                 .WebConsecutiveDelimitersAsOne = True
  52.                 .Refresh BackgroundQuery:=False
  53.             End With
  54.             '******************************
  55.        End With
  56.       
  57.        With Sheets("BSQ")
  58.            '.Rows("1:64").ClearContents
  59.            '******************************
  60.             If .QueryTables.Count > 1 Then
  61.                 .QueryTables(1).Connection = "URL;http://dj.mybank.com.tw/z/zc/zcp/zcpa/zcpa_" & stockid & ".asp.htm"
  62.             Else  '沒有QueryTable時新增
  63.                 .QueryTables.Add Connection:="URL;http://dj.mybank.com.tw/z/zc/zcp/zcpa/zcpa_" & stockid & ".asp.htm", Destination:=.Range("$A$1")
  64.             End If
  65.             With .QueryTables(1)  '不再新增
  66.                 .AdjustColumnWidth = True
  67.                 .RefreshPeriod = 0
  68.                 .WebSelectionType = xlSpecifiedTables
  69.                 .WebFormatting = xlWebFormattingNone
  70.                 .WebTables = "3"
  71.                 .WebPreFormattedTextToColumns = True
  72.                 .WebConsecutiveDelimitersAsOne = True
  73.                 .Refresh BackgroundQuery:=False
  74.             End With
  75.             '******************************
  76.        End With
  77.       
  78.             Application.DisplayAlerts = False '存檔時直接覆蓋原有檔案
  79.       
  80.             Sheets(Array("CFSQ", "ISQ", "BSQ")).Copy
  81.             ActiveWorkbook.SaveAs Filename:= _
  82.               "C:\Users\user\Desktop\Test\" & stockid & "季報.xlsx", FileFormat:= _
  83.                xlOpenXMLWorkbook, CreateBackup:=False
  84.             Windows(stockid & "季報.xlsx").Close
  85.                        
  86.             Application.DisplayAlerts = True

  88.        DELETE_QueryTables
  89.       
  90.     Next i

  92.    Application.ScreenUpdating = True
  93.    EndTime = Timer
  94.    MsgBox "本次下載共花費：" & EndTime - StartTime & "秒"
  95.       
  96.    
  97. End Sub
複製代碼
3. 程式碼加入之後，BSQ這個sheet內容會變成空白
另存新檔時，有的檔案有內容，有的檔案沒內容，這是什麼原因造成的？

4. Delete_Querytables在每一次迴圈執行完畢後呼叫對嗎？

謝謝版主回覆~

TOP

GBKEE

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

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

回復 5# bulletin
另存新檔時，有的檔案有內容，有的檔案沒內容，會是網頁上那檔股票沒有資料?
你附檔存檔的速度沒有你說的慢.
  1. Sub DELETE_QueryTables()  '僅須執行一次清除所有QueryTable
  2.     Dim SH As Worksheet, Q As Variant
  3.     For Each Q In Names
  4.         Q.Delete
  5.     Next
  6.     For Each SH In Sheets           '活頁簿的工作表集合物件
  7.         For Each Q In SH.QueryTables
  8.            Q.Delete
  9.         Next
  10.     Next
  11. End Sub
複製代碼
  1. Private Sub CommandButton1_Click()
  2.     Dim StartTime
  3.     DELETE_QueryTables  '**建議先清除***
  4.     StartTime = Timer
  5.     Application.ScreenUpdating = False
  6.     LastRow = Sheets("sheet1").Range("A2").End(xlDown).Row '找出最後一筆資料
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

bulletin

帖子
27 
主題
7 
精華
0 
積分
38 
點名
0  
作業系統
Win 7 
軟體版本
Office 2007 
閱讀權限
10 
性別
男 
註冊時間
2012-9-19 
最後登錄
2014-2-18 
7#
發表於 2014-2-6 13:48 | 只看該作者
報告GBKEE版主
也許可能是我的電腦環境問題造成速度變慢....

那請教問題2, 3的問題的原因為何？
2.呼叫Delete_Querytables時，發生1004錯誤
3.BSQ工作表空白問題

謝謝您~

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
8#
發表於 2014-2-6 14:20 | 只看該作者
回復 7# bulletin
2.呼叫Delete_Querytables時，發生1004錯誤
因執行太多次的
  1. With .QueryTables.Add(Connection:=
複製代碼
造成許多Name的位置都相同,導致第1版的Sub DELETE_QueryTables()的錯誤
所以改用 第2版的Sub DELETE_QueryTables()的程式碼





3.BSQ工作表空白問題, 可查是哪一檔股票看網頁是否也無資料
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

bulletin

帖子
27 
主題
7 
精華
0 
積分
38 
點名
0  
作業系統
Win 7 
軟體版本
Office 2007 
閱讀權限
10 
性別
男 
註冊時間
2012-9-19 
最後登錄
2014-2-18 
9#
發表於 2014-2-6 18:25 | 只看該作者
回報GBKEE版主
空白資料的網頁我都有確認過，實際上都有資料
目前暫未出現   若有其他問題再跟您請教
謝謝

速度的問題我再找找看原因
上個星期一開始寫出來的時候很快，一分鐘約存10個檔，隨檔案增加而時間暴增
不知為何現在每次執行都要1~2分鐘
有可能是虛擬記憶體沒被釋放嗎
好怪

TOP

bulletin

帖子
27 
主題
7 
精華
0 
積分
38 
點名
0  
作業系統
Win 7 
軟體版本
Office 2007 
閱讀權限
10 
性別
男 
註冊時間
2012-9-19 
最後登錄
2014-2-18 
10#
發表於 2014-2-7 10:31 | 只看該作者
報告一下結果
昨天把電腦還原到前一次備份
速度就恢復正常了
謝謝GBKEE版主~~

TOP

        靜思自在 : 知識要用心體會，才能變成自己的智慧。
12
返回列表 上一主題