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

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2016-6-6 18:46 | 顯示全部帖子

本帖最後由 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

複製代碼

2^#

發表於 2016-6-9 12:57 | 顯示全部帖子

回復 4# c_c_lai
樓上大大

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

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

靜思自在 : 多做多得。少做多失。