- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
2#
發表於 2018-9-3 16:24
| 只看該作者
本帖最後由 GBKEE 於 2018-9-3 16:27 編輯
回復 1# Scott090
沒實際執行整天行情過,請自行測試- Option Explicit
- Sub EX() '檔案開啟時請指定執行此程式
- If Time < #9:00:00 AM# Then
- Application.OnTime #9:00:00 AM#, "Ex_yahoo"
- ElseIf Time <= #2:30:00 PM# Then
- Ex_yahoo
- End If
- End Sub
- Sub Ex_yahoo()
- Dim oXmlhttp As Object, oHtmldoc As Object, E As Object
- Dim R As Integer, RR As Integer, C As Integer, xTime As Double
- If Time <= #2:30:00 PM# Then Application.OnTime #12:05:00 AM#, "Ex_yahoo" '5分鐘後再度執行
- Set oXmlhttp = CreateObject("msxml2.xmlhttp")
- Set oHtmldoc = CreateObject("htmlfile")
- With oXmlhttp
- .Open "Get", "https://tw.stock.yahoo.com/q/ts?s=2330&t=50", False
- .Send
- oHtmldoc.write .responseText
- End With
- With Sheets("工作表1")
- Set E = oHtmldoc.all.tags("table")(6)
- If .[a1] <> E.Rows(0).Cells(0).innertext & "-" & E.Rows(0).Cells(1).innertext Then
- .Cells.Clear
- .[a1] = E.Rows(0).Cells(0).innertext & "-" & E.Rows(0).Cells(1).innertext
- End If
- Set E = oHtmldoc.all.tags("table")(7)
- If .[a2] = "" Then
- For C = 0 To E.Rows(0).Cells.Length - 1
- .Cells(2, C + 1) = E.Rows(0).Cells(C).innertext
- Next
- End If
- For R = E.Rows.Length - 1 To 1 Step -1
- xTime = TimeValue(E.Rows(R).Cells(0).innertext)
- If IsError(Application.Match(xTime, .[A:A], 0)) Then
- RR = Application.CountA(.[A:A]) + 1
- For C = 0 To E.Rows(R).Cells.Length - 1
- .Cells(RR, C + 1) = E.Rows(R).Cells(C).innertext
- Next
- End If
- Next
- End With
- Set oXmlhttp = Nothing
- Set oHtmldoc = Nothing
-
- End Sub
|
|
發表於 2018-9-1 07:00
| 
