123
返回列表 上一主題 發帖

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

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

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

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

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

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 
2#
發表於 2016-6-7 10:35 | 只看該作者
回復 1# caesar0125
  1. 『For i = 5 To rc』 的 rc 如果超過十個以上，會發生以下之訊息：
  2. 所以建議不要一次無止盡的搜尋，最好分次、分時段的來執行。

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

TOP

        靜思自在 : 一個人的快樂．不是因為他擁有得多，而是因為他計較得少。
123
返回列表 上一主題