返回列表 上一主題 發帖

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

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
複製代碼
收藏 分享

bulletin

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

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

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

VBA測試專用.zip (289.89 KB)

TOP

bulletin

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

bulletin

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

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

謝謝您~

TOP

bulletin

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

TOP

bulletin

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

bulletin

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

        靜思自在 : 人事的艱難與琢磨，就是一種考驗。
返回列表 上一主題