- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
15#
發表於 2022-1-11 15:51
| 只看該作者
本帖最後由 GBKEE 於 2022-1-11 15:54 編輯
回復 11# wufonna
Pchome 的線型走勢 網頁 VBA 參考 看看- Option Explicit
- Dim Rng As Range, 資訊_Msg As Boolean, ie As New InternetExplorer
- Sub AllFile() '重新更新所有資料
- Dim i As Integer
- With Sheets("股票")
- .UsedRange.CurrentRegion.Offset(0, 1).Clear
- 資訊_Msg = True
- For i = 1 To .Range("A" & .Rows.Count).End(xlUp).Row
- 程式執行 Cells(i, 1)
- Next
- 資訊_Msg = False
- If 資訊_Msg = False Then ie.Quit
- End With
- End Sub
- Sub ex()
- 程式執行 [B1]
- End Sub
- Private Sub 程式執行(xRng As Range) '單筆更新 指定A欄的資料
- If xRng.Column > 1 Then MsgBox xRng & " 不在 A欄": Exit Sub
- ' If ie Is Nothing Then Set ie = New InternetExplorer
- Set Rng = xRng
- 股票資訊
- Rng.Select
- If 資訊_Msg = False Then ie.Quit
- End Sub
- Sub 股票資訊()
- Dim E As Object, Ar(), A As Integer, R As Integer, C As Integer
- With Rng
- A = .Parent.UsedRange.Columns.Count - 1
- If 資訊_Msg = False Then
- .Offset(, 1).Resize(, A).Select
- .Offset(, 1).Resize(, A).Clear
- End If
- If .Row = 1 Then .Cells(1, 2) = "股票名稱 ": .Cells(1, 3) = "股票價格 "
- End With
- On Error GoTo Beerr
- Be:
- With ie
- DoEvents
- .Navigate "https://pchome.megatime.com.tw/stock/sid" & Rng & ".html" '
- ' .Visible = True
- Do While .Busy Or .readyState <> 4: DoEvents: Loop
- Do: DoEvents
- If InStr(.Document.body.innertext, "查無") Then '查無 股票代號
- Rng.Offset(, 1) = "查無 " & Rng: Exit Sub
- ie.Quit
- End If
- Loop Until Not InStr(.Document.body.innertext, "查無")
- If Rng.Row > 1 Then
- Do: DoEvents
- Set E = .Document.querySelector("em[class='corp-name']") '指定這元素 <em> 讀取 (股票名稱, 代號)
- '<em class="corp-name">台 泥<span class="stock-code"> (1101)</span> </em>
- Loop Until TypeName(E) = "HTMLPhraseElement"
- If Trim(E.ALL.TAGS("SPAN")(0).innertext) <> "(" & Rng & ")" Then
- Rng.Offset(, 1) = "查無 " & Rng: Exit Sub
- Else
- Rng.Cells(, 2) = Trim(Split(E.innertext, "(")(0)) 'Split 函數 傳回一個陳列索引從零開始的一維陣列 , 它包含指定數目的子字串
- End If
- Set E = .Document.getelementbyid("stock_info_data_a").ALL.TAGS("SPAN")(0) '股票價格 id="stock_info_data_a"
- '<div class="price s-down fadein_black" id="stock_info_data_a">
- '<span class="data_close s-down">18.95</span> **TAGS("SPAN")(0) 's-down 股價下降
- '<span class="data_diff s-down">▼-0.10</span> **TAGS("SPAN")(1)
- '<span class="data_diff s-down">-0.52%</span> **TAGS("SPAN")(2)
- '<span class="data_total">18.79<em>億</em></span></div> **TAGS("SPAN")(3)
- Rng.Cells(, 3) = E.innertext
- End If
- Do While .Busy Or .readyState <> 4: DoEvents: Loop
- Do: DoEvents
- Set E = .Document.ALL.TAGS("table")(1)
- Loop Until TypeName(E) = "HTMLTable"
- If Rng.Row > 1 Then Ar = Array(3, 5, 7, 9) Else Ar = Array(2, 4, 6, 8)
- 'Rng.Row > 1 >>從第2列開始下載資料
- 'Array(2, 4, 6, 8) 為標題的Row **Ar = Array(3, 5, 7, 9 )為資料的Row
- A = 4 '設定資料欄位的起始欄位,前有 1股票代碼欄,2股票名稱欄,3股票價格欄
- For R = 0 To UBound(Ar) - 1
- For C = 0 To E.Rows(Ar(R)).Cells.Length - 1
- Rng.Cells(, A) = E.Rows(Ar(R)).Cells(C).innertext
- A = A + 1 '資料欄位+1
- Next
- Next
- End With
- Exit Sub
- Beerr:
- Set ie = New InternetExplorer
- GoTo Be
- End Sub
|
|
發表於 2022-1-6 19:01
| 
