123
返回列表 上一主題 發帖

股票資料匯入，程式執行有問題

caesar0125

帖子
8 
主題
4 
精華
0 
積分
41 
點名
0  
作業系統
win7 
軟體版本
office2010 
閱讀權限
10 
性別
男 
註冊時間
2015-1-2 
最後登錄
2016-12-28 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2016-6-6 18:46 | 只看該作者

股票資料匯入，程式執行有問題

網頁元素
本帖最後由 GBKEE 於 2016-6-17 05:03 編輯

模仿版大編改一個程式

但匯入有時會停止中斷，停止的位置不一定

我懷疑是記憶體不足，該如何改呢？
  1. Sub 歷史股價更新()
  2.     Dim xTable As Object, k As Integer, c As Integer, r As Integer, rc As Integer, sn As Integer
  3.     Dim url As String, i As Integer, E As Object
  4.     With Sheets("營運績效")
  5.           .UsedRange.Clear
  6.     End With
  7.     Sheets("總表").Select
  8.     rc = Cells(Rows.Count, 1).End(xlUp).Row
  9.     For i = 5 To rc
  10.     sn = Cells(i, 1)

  12.     url = "http://goodinfo.tw/StockInfo/StockBzPerformance.asp?STOCK_ID=" & sn & " &YEAR_PERIOD=10&RPT_CAT=M_YEAR"
  13.          With CreateObject("InternetExplorer.application")
  14.         .Visible = True
  15.         .Navigate url

  17.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  18.         Set xTable = .Document.getElementsByTagName("TABLE")(11) '資料在這
  19.         With Sheets("營運績效")

  21.             k = k + 1
  22.             For r = 0 To xTable.Rows.Length - 1
  23.                 For c = 0 To xTable.Rows(r).Cells.Length - 1
  24.                     .Cells(k, c + 1) = xTable.Rows(r).Cells(c).innertext
  25.                 Next
  26.                 k = k + 1
  27.             Next
  28.         End With
  29.         Set xTable = .Document.getElementsByTagName("TABLE")(13) '資料在這
  30.         With Sheets("營運績效")

  32.             k = k + 1
  33.             For r = 0 To xTable.Rows.Length - 1
  34.                 For c = 0 To xTable.Rows(r).Cells.Length - 1
  35.                     .Cells(k, c + 1) = xTable.Rows(r).Cells(c).innertext
  36.                 Next
  37.                 k = k + 1
  38.             Next
  39.         End With
  40.         Set xTable = .Document.getElementsByTagName("TABLE")(19) '資料在這
  41.         With Sheets("營運績效")

  43.             k = k + 1

  45.              For r = 0 To 3
  46.                 For c = 0 To xTable.Rows(r).Cells.Length - 1
  47.                     .Cells(k, c + 1) = xTable.Rows(r).Cells(c).innertext
  48.                 Next
  49.                 k = k + 1
  50.             Next
  51.         End With
  52.         .Quit
  53.     End With
  54.     Next
  55. End Sub
複製代碼
收藏 分享

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
2#
發表於 2016-6-7 10:35 | 只看該作者
回復 1# caesar0125
  1. 『For i = 5 To rc』 的 rc 如果超過十個以上，會發生以下之訊息：
  2. 所以建議不要一次無止盡的搜尋，最好分次、分時段的來執行。

  4. 「網站偵測到您的瀏覽量異常, 目前暫時關閉服務, 請稍後再重新查詢」
複製代碼

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
3#
發表於 2016-6-7 10:55 | 只看該作者
回復 1# caesar0125
我將程式稍稍整理了一下，
加強 Focus 到 Sheets("營運績效")。
  1. Sub 歷史股價更新()
  2.     Dim xTable As Object, k As Integer, c As Integer, r As Integer, rc As Integer, sn As Integer
  3.     Dim url As String, i As Integer, E As Object
  4.    
  5.     Sheets("總表").Select
  6.     rc = Cells(Rows.Count, 1).End(xlUp).Row
  7.     k = 0
  8.    
  9.     With Sheets("營運績效")
  10.         .Select
  11.         .UsedRange.Clear
  12.     End With
  13.    
  14.     '  For i = 5 To rc
  15.     For i = 1 To 5
  16.         sn = Sheets("總表").Cells(i, 1)
  17.         url = "http://goodinfo.tw/StockInfo/StockBzPerformance.asp?STOCK_ID=" & sn & " &YEAR_PERIOD=10&RPT_CAT=M_YEAR"

  19.         With CreateObject("InternetExplorer.application")
  20.             .Visible = True
  21.             .Navigate url

  23.             Do While .Busy Or .readyState <> 4: DoEvents: Loop
  24.         
  25.             Set xTable = .Document.getElementsByTagName("TABLE")(11)    '  資料在這
  26.         
  27.             With Sheets("營運績效")
  28.                 k = k + 1
  29.                 For r = 0 To xTable.Rows.Length - 1
  30.                     For c = 0 To xTable.Rows(r).Cells.Length - 1
  31.                         .Cells(k, c + 1) = xTable.Rows(r).Cells(c).innertext
  32.                     Next
  33.                     k = k + 1
  34.                 Next
  35.             End With
  36.         
  37.             Set xTable = .Document.getElementsByTagName("TABLE")(13)    '  資料在這
  38.             With Sheets("營運績效")
  39.                 k = k + 1
  40.                 For r = 0 To xTable.Rows.Length - 1
  41.                     For c = 0 To xTable.Rows(r).Cells.Length - 1
  42.                         .Cells(k, c + 1) = xTable.Rows(r).Cells(c).innertext
  43.                     Next
  44.                     k = k + 1
  45.                 Next
  46.             End With
  47.         
  48.             Set xTable = .Document.getElementsByTagName("TABLE")(19)    '  資料在這
  49.             With Sheets("營運績效")
  50.                 k = k + 1
  51.                 '  For r = 0 To 3
  52.                 For r = 0 To xTable.Rows.Length - 1
  53.                     For c = 0 To xTable.Rows(r).Cells.Length - 1
  54.                         .Cells(k, c + 1) = xTable.Rows(r).Cells(c).innertext
  55.                     Next
  56.                     k = k + 1
  57.                 Next
  58.             End With
  59.             
  60.             .Quit
  61.         End With
  62.     Next
  63. End Sub
複製代碼

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
4#
發表於 2016-6-7 10:59 | 只看該作者
回復 1# caesar0125

TOP

caesar0125

帖子
8 
主題
4 
精華
0 
積分
41 
點名
0  
作業系統
win7 
軟體版本
office2010 
閱讀權限
10 
性別
男 
註冊時間
2015-1-2 
最後登錄
2016-12-28 
5#
發表於 2016-6-9 12:57 | 只看該作者
回復 4# c_c_lai
樓上大大

我的股票清單有50個，分批資料該如何處

我的程式是因為我的網路速度問題？有時捉到清單第3、4個，有時可捉到第20幾個

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#
發表於 2016-6-9 14:30 | 只看該作者
回復 5# caesar0125
我用IE8 抓取資料也有困難
改用      CreateObject("msxml2.xmlhttp") + CreateObject("htmlfile")
試看看
  1. Sub goodinfo_合併財報()
  2.     Dim xTable As Object, k As Integer, C As Integer, R As Integer, rc As Integer, sn As Integer
  3.     Dim url As String, i As Integer, E As Variant
  4.     Dim oXmlhttp As Object, oHtmldoc As Object, surl, op
  5.     'Sheets("總表").Select
  6.     rc = Sheets("總表").Cells(Rows.Count, 1).End(xlUp).Row
  7.     Sheets("營運績效").UsedRange.Clear
  8.     For i = 5 To rc
  9.         sn = Sheets("總表").Cells(i, 1)
  10.         url = "http://goodinfo.tw/StockInfo/StockBzPerformance.asp?STOCK_ID=" & sn & " &YEAR_PERIOD=10&RPT_CAT=M_YEAR"
  11.          Set oXmlhttp = CreateObject("msxml2.xmlhttp")
  12.          Set oHtmldoc = CreateObject("htmlfile")
  13.          With oXmlhttp
  14.             .Open "Get", url, False
  15.             .Send
  16.             oHtmldoc.write .responseText
  17.         End With
  18.         Set xTable = oHtmldoc.all.tags("TABLE")
  19.         With Sheets("營運績效")
  20.           '  .Cells.Clear
  21.             For Each E In Array(11, 13, 19) '11,13,19  "TABLE"
  22.                 k = k + 1
  23.                 For R = 0 To xTable(E).Rows.Length - 1
  24.                     For C = 0 To xTable(E).Rows(R).Cells.Length - 1
  25.                         .Cells(k, C + 1) = xTable(E).Rows(R).Cells(C).innertext
  26.                     Next
  27.                     k = k + 1
  28.                 Next
  29.             Next
  30.           End With
  31.     Next
  32. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
7#
發表於 2016-6-10 07:23 | 只看該作者
本帖最後由 c_c_lai 於 2016-6-10 07:25 編輯

回復 5# caesar0125
你試試樓上 GBKEE 版大的模組，
其執行效率與速度非常的佳。 畢竟
CreateObject("InternetExplorer.application")
之處裡的確耗時過久。

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
8#
發表於 2016-6-10 09:45 | 只看該作者
回復 6# GBKEE
請教您，有好多回執行到
  1.         Set xTable = oHtmldoc.all.tags("TABLE")
  2.         With Sheets("營運績效")
  3.             '  .Cells.Clear
  4.             For Each E In Array(11, 13, 19) '11,13,19  "TABLE"
  5.                 k = k + 1
  6.                 For R = 0 To xTable(E).Rows.Length - 1
複製代碼
中的   xTable(E).Rows.Length， 便產生如下之錯誤訊息：
  1. 執行階段錯誤 '91'
  2. 沒有設定物件變數或 With 區域變數
複製代碼
查看 oXmlhttp.responseText : "<!DOCTYPE HTML>
<html lang="zh-TW">
<head>
  <meta http-equiv="Content-Type" content="text/html; charset=utf-8">
  <meta http-equiv="X-UA-Compatible" content="I
又看不出有任何狀況， 有時 xTable.length = 0 或  xTable.length =  1 等。

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
9#
發表於 2016-6-10 10:27 | 只看該作者
回復 8# c_c_lai
可加上防錯
  1. Do
  2.             Set xTable = oHtmldoc.all.tags("TABLE")
  3.             Debug.Print xTable.Length, sn
  4.           ' If xTable.Length >= 19 Then Stop
  5.         Loop Until xTable.Length >= 19
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
10#
發表於 2016-6-10 16:13 | 只看該作者
回復  c_c_lai
可加上防錯
GBKEE 發表於 2016-6-10 10:27

如果 xTable.Length 為零，
Until xTable.Length >= 19 會如同死胡同
永遠出不來，所以我改成
If xTable.Length >= 19 Then
     .
    .
End If
仍然是一推
  1. 1             0             1437
  2. 2             0             1438
  3. 3             0             1439
  4. 4             0             1440
  5. 5             0             1441
複製代碼

TOP

        靜思自在 : 話多不如話少，話少不如話好。
123
返回列表 上一主題