- 帖子
- 13
- 主題
- 0
- 精華
- 0
- 積分
- 63
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- office 365
- 閱讀權限
- 20
- 性別
- 女
- 註冊時間
- 2022-2-1
- 最後登錄
- 2024-11-20
|
2#
發表於 2022-6-4 18:44
| 只看該作者
回復 1# t8899 - Option Explicit
- Sub Ex_奇摩股市ADR()
- Dim E As Object, i As Integer, R As Integer, C As Integer
- Dim SH As Worksheet, Span As Object, S As Variant
- Dim Rng As Range
- Set SH = Sheets(1)
- SH.Cells.Clear
- S = Split("股名/股號,,股價,漲跌,漲跌幅(%),買進,賣出,開盤,昨收,最高,最低,成交量 (股),時間 (CST)", ",")
- SH.Range("A1").Resize(, UBound(S) + 1) = S
- With CreateObject("InternetExplorer.Application")
- .Visible = True
- .Navigate "https://tw.stock.yahoo.com/adr"
- Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
- Set E = .Document.querySelector("ul[class='M(0) P(0) List(n)']").all.tags("LI")
- For i = 0 To E.Length - 1
- '***** 元素( LI ) 讀取整列.innertext 清除 Chr(13) & Chr(10) 字元 *******************
- ' S = Replace(E(i).innertext, Chr(13) & Chr(10), "*")
- ' Do
- ' S = Replace(S, "**", "*")
- ' Loop While InStr(S, "**")
- ' S = Split(Mid(S, 2), "*")
- ' With SH.Cells(i + 2, 1).Resize(, UBound(S) + 1)
- ' .Cells = S
- '.Value = .Value
- ' End With
- '***** 元素( LI )下的元素(Span) 讀取整列.innertext 清除空白字元 *******************
- Set Span = E(i).all.tags("span")
- Set Rng = SH.Range("a" & i + 2)
- For C = 1 To Span.Length - 1
- If Span(C).innertext <> "" Then
- Rng = Span(C).innertext
- Set Rng = Rng.Offset(, 1)
- End If
- Next
- Next
- .Quit '關閉網頁
- End With
- End Sub
複製代碼 |
|