- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
6#
發表於 2020-4-1 16:27
| 只看該作者
本帖最後由 GBKEE 於 2020-4-1 16:29 編輯
回復 4# abc9gad2016
試試看- Sub 更新全部()
- Call 共用參照: If uRow <= 0 Then Exit Sub
- uHead(0, 0) = "※更新中.............."
- uHead(2, 12).Resize(uRow).ClearContents
- For Each uRng In uClmnNo
- uRng(1, 3).Resize(1, 10).ClearContents
- 網頁元素_htmlfile uRng
- Beep
- Next
- uHead(0, 0) = "※更新時間：" & Format(Now, "yyyy/mm/dd hh:mm:ss")
- ThisWorkbook.Save
- End Sub
- Sub 網頁元素_htmlfile(uRng As Range)
- Dim oXmlhttp As Object, oHtmldoc As Object, surl As String, E As Object, i As Integer
- Set oXmlhttp = CreateObject("msxml2.xmlhttp")
- Set oHtmldoc = CreateObject("htmlfile")
- If uRng = "" Then Exit Sub
- surl = "https://tw.stock.yahoo.com/q/q?s=" & uRng
- With oXmlhttp
- .Open "Get", surl, False
- .Send
- oHtmldoc.write .responseText
- End With
- On Error GoTo Ne '處理股票代碼不存在時程式的出錯
- With oHtmldoc
- Set E = .all.tags("TABLE")(2).Rows(1).Cells '股票代碼不存時 E Is Nothing
- '** .Rows(1).Cells 網頁表格的內容 ****
- uRng.Cells(1, 2) = Split(E(0).INNERTEXT, vbCrLf)(0) '去掉換行後的字元
- uRng.Cells(1, 2) = Replace(uRng.Cells(1, 2), uRng, "") '消除股票代碼
- For i = 2 To E.Length - 2
- If i = 2 + 3 Then
- uRng.Cells(1, i + 1) = Mid(E(i).INNERTEXT, 2) '**消除漲跌的符號**
- Else
- uRng.Cells(1, i + 1) = E(i).INNERTEXT
- End If
- Next
- uRng.Cells(1, i + 1) = E(1).INNERTEXT '交易時間
- End With
- Ne:
- uRng.Interior.Color = IIf(E Is Nothing, vbRed, xlAutomatic) '
- Set oXmlhttp = Nothing '
- Set oHtmldoc = Nothing
- End Sub
|
-
1
評分人數
-
|
發表於 2020-3-31 14:45
| 
發表於 2020-3-31 19:14
| 
