- 帖子
- 8
- 主題
- 4
- 精華
- 0
- 積分
- 41
- 點名
- 0
- 作業系統
- win7
- 軟體版本
- office2010
- 閱讀權限
- 10
- 性別
- 男
- 註冊時間
- 2015-1-2
- 最後登錄
- 2016-12-28
|
本帖最後由 GBKEE 於 2016-6-17 05:03 編輯
模仿版大編改一個程式
但匯入有時會停止中斷,停止的位置不一定
我懷疑是記憶體不足,該如何改呢?- Sub 歷史股價更新()
- Dim xTable As Object, k As Integer, c As Integer, r As Integer, rc As Integer, sn As Integer
- Dim url As String, i As Integer, E As Object
- With Sheets("營運績效")
- .UsedRange.Clear
- End With
- Sheets("總表").Select
- rc = Cells(Rows.Count, 1).End(xlUp).Row
- For i = 5 To rc
- sn = Cells(i, 1)
- url = "http://goodinfo.tw/StockInfo/StockBzPerformance.asp?STOCK_ID=" & sn & " &YEAR_PERIOD=10&RPT_CAT=M_YEAR"
- With CreateObject("InternetExplorer.application")
- .Visible = True
- .Navigate url
-
- Do While .Busy Or .readyState <> 4: DoEvents: Loop
- Set xTable = .Document.getElementsByTagName("TABLE")(11) '資料在這
- With Sheets("營運績效")
- k = k + 1
- For r = 0 To xTable.Rows.Length - 1
- For c = 0 To xTable.Rows(r).Cells.Length - 1
- .Cells(k, c + 1) = xTable.Rows(r).Cells(c).innertext
- Next
- k = k + 1
- Next
- End With
- Set xTable = .Document.getElementsByTagName("TABLE")(13) '資料在這
- With Sheets("營運績效")
- k = k + 1
- For r = 0 To xTable.Rows.Length - 1
- For c = 0 To xTable.Rows(r).Cells.Length - 1
- .Cells(k, c + 1) = xTable.Rows(r).Cells(c).innertext
- Next
- k = k + 1
- Next
- End With
- Set xTable = .Document.getElementsByTagName("TABLE")(19) '資料在這
- With Sheets("營運績效")
- k = k + 1
- For r = 0 To 3
- For c = 0 To xTable.Rows(r).Cells.Length - 1
- .Cells(k, c + 1) = xTable.Rows(r).Cells(c).innertext
- Next
- k = k + 1
- Next
- End With
- .Quit
- End With
- Next
- End Sub
複製代碼 |
|