- 帖子
- 2035
- 主題
- 24
- 精華
- 0
- 積分
- 2031
- 點名
- 0
- 作業系統
- Win7
- 軟體版本
- Office2010
- 閱讀權限
- 100
- 性別
- 男
- 註冊時間
- 2012-3-22
- 最後登錄
- 2024-2-1
|
回復 1# caesar0125
我將程式稍稍整理了一下,
加強 Focus 到 Sheets("營運績效")。- 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
-
- Sheets("總表").Select
- rc = Cells(Rows.Count, 1).End(xlUp).Row
- k = 0
-
- With Sheets("營運績效")
- .Select
- .UsedRange.Clear
- End With
-
- ' For i = 5 To rc
- For i = 1 To 5
- sn = Sheets("總表").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 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
-
- .Quit
- End With
- Next
- End Sub
複製代碼 |
|