Board logo

標題: [發問] 程式執行速度越來越慢 [打印本頁]
作者: bulletin    時間: 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    時間: 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
複製代碼
作者: bulletin    時間: 2014-2-5 22:57

回復 2# GBKEE

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

請問您回覆的內容該怎麼使用...
我還不會使用module
直接放到一個新的檔案中執行也發生問題
不知道該如何使用它
很抱歉造成您的困擾~
作者: GBKEE    時間: 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
複製代碼
作者: bulletin    時間: 2014-2-6 11:52

回復 4# GBKEE

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

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

2. 呼叫Delete_QueryTables，發生錯誤1004
錯誤內容如下圖
[attach]17438[/attach]
我發現錯誤內容是Q.name的地方成為"zc3_2002.djhtm_231"
不懂為何後面會多了_231這幾個字

[attach]17437[/attach]
  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在每一次迴圈執行完畢後呼叫對嗎？

謝謝版主回覆~
作者: GBKEE    時間: 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 '找出最後一筆資料
複製代碼
作者: bulletin    時間: 2014-2-6 13:48

報告GBKEE版主
也許可能是我的電腦環境問題造成速度變慢....

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

謝謝您~
作者: GBKEE    時間: 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()的程式碼


[attach]17439[/attach]


3.BSQ工作表空白問題, 可查是哪一檔股票看網頁是否也無資料
作者: bulletin    時間: 2014-2-6 18:25

回報GBKEE版主
空白資料的網頁我都有確認過，實際上都有資料
目前暫未出現   若有其他問題再跟您請教
謝謝

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

報告一下結果
昨天把電腦還原到前一次備份
速度就恢復正常了
謝謝GBKEE版主~~
作者: bulletin    時間: 2014-2-7 11:27

回復 10# bulletin

請教GBKEE版主
我發現執行時
每100~200筆就會發生1004錯誤
這是因為用到大量的COPY  導致記憶體出錯嗎？

將程式改寫，將資料抓取到名為temp的工作表，依序另存到新檔
是否可以改善？

或是有可能是其他原因所造成？
  1. Private Sub CommandButton1_Click()

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


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

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

  98.    Application.ScreenUpdating = True
  99.    EndTime = Timer
  100.    MsgBox "本次下載共花費：" & EndTime - StartTime & "秒"
  101.       
  102.    
  103. End Sub
複製代碼
作者: Hsieh    時間: 2014-2-7 14:22

回復 10# bulletin


    web查詢跟你網路連線速度有關
當主機伺服器接受太多連線或是主機端有流量管制
對同一IP的流量進行管控時
可能就無法取得資料
作者: bulletin    時間: 2014-2-7 17:43

回復 12# Hsieh

我也想過是流量管制的問題
多謝說明

無論如何來改寫成temp好了
當做練習也好
到時再請各位前輩指教
作者: bulletin    時間: 2014-2-7 21:02

回復 13# bulletin

各位前輩
我又修改了一個，這次直接先開啟新的活頁簿
並將資料直接存入活頁簿中

1. 先抓資料，再複製另存新檔
100筆 --> 102秒
200筆 --> 210秒

2. 先建立新檔再抓資料存檔
100筆 --> 100秒
200筆 --> 206秒

似乎少了複製另存速度稍稍快一點
但是考量網路穩定性以及網站存取的問題
應該是沒有差

此外仍然有錯誤1004的問題, 所以沒辦法測試500筆以上或是所有上市櫃公司1400檔的速度...

錯誤會發生在複製網頁資料，存到工作表中時
不一定會在何時發生
但原則上仍留在100~200筆之間會發生
我再把延遲時間拉長，看能不能避免錯誤1004
謝謝各位前輩指教~
  1. Sub stest()

  3.     Dim StartTime, LastRow
  4.     Dim wbnew As Workbook
  5.    
  6.     DELETE_QueryTables
  7.    
  8.     StartTime = Timer
  9.     LastRow = Sheets("sheet1").Range("A2").End(xlDown).Row '找出最後一筆資料

  11.     Application.ScreenUpdating = False
  12.    
  13.     For i = 2 To 101
  14.         
  15.         Dim stockid
  16.         stockid = Range("A" & i).Value
  17.    
  18.         Application.DisplayAlerts = False
  19.         Application.Wait Now + TimeValue("00:00:01")
  20.         
  21.         
  22.         Set wbnew = Workbooks.Add() '新增活頁簿
  23.         wbnew.SaveAs Filename:="C:\Users\KT\Desktop\Test2\" & stockid & ".xlsx"  '另存新檔

  25.         With wbnew.Sheets(1) 'CFSQ
  26.            '.Rows("1:64").ClearContents
  27.            
  28.            '******************************
  29.             If .QueryTables.Count > 1 Then
  30.                 .QueryTables(1).Connection = "URL;http://dj.mybank.com.tw/z/zc/zc3/zc3_" & stockid & ".djhtm"
  31.             Else  '沒有QueryTable時新增
  32.                 .QueryTables.Add Connection:="URL;http://dj.mybank.com.tw/z/zc/zc3/zc3_" & stockid & ".djhtm", Destination:=.Range("$A$1")
  33.             End If
  34.             With .QueryTables(1)  '不再新增
  35.                 .AdjustColumnWidth = True
  36.                 .RefreshPeriod = 0
  37.                 .WebSelectionType = xlSpecifiedTables
  38.                 .WebFormatting = xlWebFormattingNone
  39.                 .WebTables = "3"
  40.                 .WebPreFormattedTextToColumns = True
  41.                 .WebConsecutiveDelimitersAsOne = True
  42.                 .Refresh BackgroundQuery:=False
  43.             End With
  44.             '******************************
  45.             
  46.        End With
  47.       
  48.     With Sheets(2)
  49.            '.Rows("1:64").ClearContents
  50.            
  51.            '******************************
  52.             If .QueryTables.Count > 1 Then
  53.                 .QueryTables(1).Connection = "URL;http://dj.mybank.com.tw/z/zc/zcq/zcq_" & stockid & ".asp.htm"
  54.             Else  '沒有QueryTable時新增
  55.                 .QueryTables.Add Connection:="URL;http://dj.mybank.com.tw/z/zc/zcq/zcq_" & stockid & ".asp.htm", Destination:=.Range("$A$1")
  56.             End If
  57.             With .QueryTables(1)  '不再新增
  58.                 .AdjustColumnWidth = True
  59.                 .RefreshPeriod = 0
  60.                 .WebSelectionType = xlSpecifiedTables
  61.                 .WebFormatting = xlWebFormattingNone
  62.                 .WebTables = "3"
  63.                 .WebPreFormattedTextToColumns = True
  64.                 .WebConsecutiveDelimitersAsOne = True
  65.                 .Refresh BackgroundQuery:=False
  66.             End With
  67.             '******************************
  68.             
  69.        End With
  70.       
  71.        With Sheets(2)
  72.            '.Rows("1:64").ClearContents
  73.            
  74.            '******************************
  75.             If .QueryTables.Count > 1 Then
  76.                 .QueryTables(1).Connection = "URL;http://dj.mybank.com.tw/z/zc/zcp/zcpa/zcpa_" & stockid & ".asp.htm"
  77.             Else  '沒有QueryTable時新增
  78.                 .QueryTables.Add Connection:="URL;http://dj.mybank.com.tw/z/zc/zcp/zcpa/zcpa_" & stockid & ".asp.htm", Destination:=.Range("$A$1")
  79.             End If
  80.             With .QueryTables(1)  '不再新增
  81.                 .AdjustColumnWidth = True
  82.                 .RefreshPeriod = 0
  83.                 .WebSelectionType = xlSpecifiedTables
  84.                 .WebFormatting = xlWebFormattingNone
  85.                 .WebTables = "3"
  86.                 .WebPreFormattedTextToColumns = True
  87.                 .WebConsecutiveDelimitersAsOne = True
  88.                 .Refresh BackgroundQuery:=False
  89.             End With
  90.             '******************************
  91.            
  92.        End With
  93.       
  94.        Windows(stockid & ".xlsx").Close savechanges:=True
  95.        Application.DisplayAlerts = True

  97.     Next i
  98.    
  99.    
  100.    Application.ScreenUpdating = True
  101.    EndTime = Timer
  102.    MsgBox "本次下載共花費：" & EndTime - StartTime & "秒"
  103.       
  104.    
  105. End Sub
複製代碼
作者: heavenweaver    時間: 2014-3-2 15:31

回復 14# bulletin
我抓台灣50，花了約56秒。

            
With wbnew.Sheets(1) 'CFSQ
               '.Rows("1:64").ClearContents
               
               '******************************
                If .QueryTables.Count > 1 Then
                    .QueryTables(1).Connection = "URL;http://dj.mybank.com.tw/z/zc/zc3/zc3_" & stockid & ".djhtm"
                Else  '沒有QueryTable時新增
                    .QueryTables.Add Connection:="URL;http://dj.mybank.com.tw/z/zc/zc3/zc3_" & stockid & ".djhtm", Destination:=.Range("$A$1")
                End If
                With .QueryTables(1)  '不再新增
                    .AdjustColumnWidth = True
                    .RefreshPeriod = 0
                    .WebSelectionType = xlSpecifiedTables
                    .WebFormatting = xlWebFormattingNone
                    .WebTables = "3"
                    .WebPreFormattedTextToColumns = True
                    .WebConsecutiveDelimitersAsOne = True
                    .Refresh BackgroundQuery:=False
                End With
                '******************************
               
           End With
         
        With wbnew.Sheets(2)
               '.Rows("1:64").ClearContents
               
               '******************************
                If .QueryTables.Count > 1 Then
                    .QueryTables(1).Connection = "URL;http://dj.mybank.com.tw/z/zc/zcq/zcq_" & stockid & ".asp.htm"
                Else  '沒有QueryTable時新增
                    .QueryTables.Add Connection:="URL;http://dj.mybank.com.tw/z/zc/zcq/zcq_" & stockid & ".asp.htm", Destination:=.Range("$A$1")
                End If
                With .QueryTables(1)  '不再新增
                    .AdjustColumnWidth = True
                    .RefreshPeriod = 0
                    .WebSelectionType = xlSpecifiedTables
                    .WebFormatting = xlWebFormattingNone
                    .WebTables = "3"
                    .WebPreFormattedTextToColumns = True
                    .WebConsecutiveDelimitersAsOne = True
                    .Refresh BackgroundQuery:=False
                End With
                '******************************
               
           End With
         
           With wbnew.Sheets(3)
               '.Rows("1:64").ClearContents
               
               '******************************
                If .QueryTables.Count > 1 Then
                    .QueryTables(1).Connection = "URL;http://dj.mybank.com.tw/z/zc/zcp/zcpa/zcpa_" & stockid & ".asp.htm"
                Else  '沒有QueryTable時新增
                    .QueryTables.Add Connection:="URL;http://dj.mybank.com.tw/z/zc/zcp/zcpa/zcpa_" & stockid & ".asp.htm", Destination:=.Range("$A$1")
                End If
                With .QueryTables(1)  '不再新增
                    .AdjustColumnWidth = True
                    .RefreshPeriod = 0
                    .WebSelectionType = xlSpecifiedTables
                    .WebFormatting = xlWebFormattingNone
                    .WebTables = "3"
                    .WebPreFormattedTextToColumns = True
                    .WebConsecutiveDelimitersAsOne = True
                    .Refresh BackgroundQuery:=False
                End With
                '******************************
               
           End With

作者: heavenweaver    時間: 2014-3-2 20:55

回復 14# bulletin
  1. Sub stest()

  3.         Dim StartTime, LastRow
  4.         Dim wbnew As Workbook
  5.       
  6.         DELETE_QueryTables
  7.       
  8.         StartTime = Timer
  9.         LastRow = Sheets("sheet1").Range("A2").End(xlDown).Row '找出最後一筆資料

  11.         Application.ScreenUpdating = False
  12.       
  13.         For i = 1 To 50
  14.             
  15.             Dim stockid
  16.             If i <= 50 Then
  17.                stockid = Range("A" & i + 10).Value
  18.             Else
  19.                stockid = Range("B" & i + 10).Value
  20.             End If
  21.             Application.DisplayAlerts = False
  22.             Application.Wait Now + TimeValue("00:00:01")
  23.             
  24.             
  25.             Set wbnew = Workbooks.Add() '新增活頁簿
  26.             'wbnew.SaveAs Filename:="C:\myStock\Test\" & stockid & ".xls"  '另存新檔
  27.             wbnew.SaveAs Filename:="C:\myStock\Test\" & stockid & "季報.xls"  '另存新檔

  29.             With wbnew.Sheets(1) 'CFSQ
  30.                '.Rows("1:64").ClearContents
  31.                
  32.                '******************************
  33.                 If .QueryTables.Count > 1 Then
  34.                     .QueryTables(1).Connection = "URL;http://dj.mybank.com.tw/z/zc/zc3/zc3_" & stockid & ".djhtm"
  35.                 Else  '沒有QueryTable時新增
  36.                     .QueryTables.Add Connection:="URL;http://dj.mybank.com.tw/z/zc/zc3/zc3_" & stockid & ".djhtm", Destination:=.Range("$A$1")
  37.                 End If
  38.                 With .QueryTables(1)  '不再新增
  39.                     .AdjustColumnWidth = True
  40.                     .RefreshPeriod = 0
  41.                     .WebSelectionType = xlSpecifiedTables
  42.                     .WebFormatting = xlWebFormattingNone
  43.                     .WebTables = "3"
  44.                     .WebPreFormattedTextToColumns = True
  45.                     .WebConsecutiveDelimitersAsOne = True
  46.                     .Refresh BackgroundQuery:=False
  47.                 End With
  48.                 '******************************
  49.                
  50.            End With
  51.          
  52.         With wbnew.Sheets(2)
  53.                '.Rows("1:64").ClearContents
  54.                
  55.                '******************************
  56.                 If .QueryTables.Count > 1 Then
  57.                     .QueryTables(1).Connection = "URL;http://dj.mybank.com.tw/z/zc/zcq/zcq_" & stockid & ".asp.htm"
  58.                 Else  '沒有QueryTable時新增
  59.                     .QueryTables.Add Connection:="URL;http://dj.mybank.com.tw/z/zc/zcq/zcq_" & stockid & ".asp.htm", Destination:=.Range("$A$1")
  60.                 End If
  61.                 With .QueryTables(1)  '不再新增
  62.                     .AdjustColumnWidth = True
  63.                     .RefreshPeriod = 0
  64.                     .WebSelectionType = xlSpecifiedTables
  65.                     .WebFormatting = xlWebFormattingNone
  66.                     .WebTables = "3"
  67.                     .WebPreFormattedTextToColumns = True
  68.                     .WebConsecutiveDelimitersAsOne = True
  69.                     .Refresh BackgroundQuery:=False
  70.                 End With
  71.                 '******************************
  72.                
  73.            End With
  74.          
  75.            With wbnew.Sheets(3)
  76.                '.Rows("1:64").ClearContents
  77.                
  78.                '******************************
  79.                 If .QueryTables.Count > 1 Then
  80.                     .QueryTables(1).Connection = "URL;http://dj.mybank.com.tw/z/zc/zcp/zcpa/zcpa_" & stockid & ".asp.htm"
  81.                 Else  '沒有QueryTable時新增
  82.                     .QueryTables.Add Connection:="URL;http://dj.mybank.com.tw/z/zc/zcp/zcpa/zcpa_" & stockid & ".asp.htm", Destination:=.Range("$A$1")
  83.                 End If
  84.                 With .QueryTables(1)  '不再新增
  85.                     .AdjustColumnWidth = True
  86.                     .RefreshPeriod = 0
  87.                     .WebSelectionType = xlSpecifiedTables
  88.                     .WebFormatting = xlWebFormattingNone
  89.                     .WebTables = "3"
  90.                     .WebPreFormattedTextToColumns = True
  91.                     .WebConsecutiveDelimitersAsOne = True
  92.                     .Refresh BackgroundQuery:=False
  93.                 End With
  94.                 '******************************
  95.                
  96.            End With
  97.          
  98.            'Windows(stockid & ".xls").Close savechanges:=True
  99.            Windows(stockid & "季報.xls").Close savechanges:=True
  100.            Application.DisplayAlerts = True

  102.         Next i
  103.       
  104.       
  105.        Application.ScreenUpdating = True
  106.        EndTime = Timer
  107.        MsgBox "本次下載共花費：" & EndTime - StartTime & "秒"
  108.          
  109.       
  110. End Sub
複製代碼




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