- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
2#
發表於 2017-7-7 12:28
| 只看該作者
回復 1# shuasa
試試看- Option Explicit
- Private Sub Worksheet_Change(ByVal Target As Range)
- Application.EnableEvents = False
- If Target.Address = "$B$1" Then 'B1變更就執行 (更新資料)
- Ex_上櫃個股成交資 Target
- End If
- Application.EnableEvents = True
- End Sub
- Sub Ex_上櫃個股成交資(nCode)
- Dim E As Object, R As Integer, C As Integer, St As String, Rng As Range
- With CreateObject("InternetExplorer.Application")
- .Visible = True
- .Top = 1: .Left = 1: .Width = 1: .Height = 1
- .Navigate "http://www.tpex.org.tw/web/stock/statistics/monthly/st42.php?l=zh-tw"
- Do While .Busy Or .readyState <> 4: DoEvents: Loop
- With .Document.all("input_stock_code")
- .Value = nCode
- .Focus
- Application.SendKeys "~" '按下Eenter鍵
- End With
- Do While .Busy Or .readyState <> 4: DoEvents: Loop
- Do While .Document.all.tags("table") Is Nothing: DoEvents: Loop
- Do While .Document.all.tags("table").Length < 4:
- Set E = .Document.all.tags("table")(0)
- If InStr(E.innertext, "查無該筆資料,請重新查詢!!") Then St = nCode & vbLf & E.innertext: GoTo bby
- If InStr(E.innertext, "您輸入的股票代碼有誤，請檢查!!") Then St = nCode & vbLf & "的股票代碼有誤，請檢查": GoTo bby
- DoEvents
- Loop
- Set E = .Document.all.tags("table")(2)
- Set Rng = Range("b3")
- With Rng
- .CurrentRegion.Clear
- For R = 0 To E.Rows.Length - 1
- For C = 0 To E.Rows(R).Cells.Length - 1
- .Cells(R + 1, C + 1) = E.Rows(R).Cells(C).innertext
- Next
- Next
- End With
- Rng = .Document.all.tags("table")(0).Rows(0).Cells(1).innertext
- bby:
- .Quit '關閉網頁
- End With
- If St <> "" Then MsgBox vbTab & St: Range("b3").CurrentRegion.Clear
- End Sub
|
|
發表於 2017-7-6 11:22
| 
