12
返回列表 上一主題 發帖

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

bulletin

帖子
27 
主題
7 
精華
0 
積分
38 
點名
0  
作業系統
Win 7 
軟體版本
Office 2007 
閱讀權限
10 
性別
男 
註冊時間
2012-9-19 
最後登錄
2014-2-18 
11# 跳轉到 »
發表於 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
複製代碼

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
164  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2025-7-8 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
12#
發表於 2014-2-7 14:22 | 只看該作者
回復 10# bulletin


    web查詢跟你網路連線速度有關
當主機伺服器接受太多連線或是主機端有流量管制
對同一IP的流量進行管控時
可能就無法取得資料
學海無涯_不恥下問

TOP

bulletin

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

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

無論如何來改寫成temp好了
當做練習也好
到時再請各位前輩指教

TOP

bulletin

帖子
27 
主題
7 
精華
0 
積分
38 
點名
0  
作業系統
Win 7 
軟體版本
Office 2007 
閱讀權限
10 
性別
男 
註冊時間
2012-9-19 
最後登錄
2014-2-18 
14#
發表於 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
複製代碼

TOP

heavenweaver

帖子
48 
主題
6 
精華
0 
積分
60 
點名
0  
作業系統
XP 
軟體版本
Office 2003 
閱讀權限
20 
性別
男 
註冊時間
2012-8-13 
最後登錄
2023-2-7 
15#
發表於 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

很抱歉，我是小學生，不能下載檔案，是個小屁孩！

TOP

heavenweaver

帖子
48 
主題
6 
精華
0 
積分
60 
點名
0  
作業系統
XP 
軟體版本
Office 2003 
閱讀權限
20 
性別
男 
註冊時間
2012-8-13 
最後登錄
2023-2-7 
16#
發表於 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
複製代碼
很抱歉，我是小學生，不能下載檔案，是個小屁孩！

TOP

        靜思自在 : 稻穗結得越飽滿，越會往下垂，一個人越有成就，就要越有謙沖的胸襟。
12
返回列表 上一主題