- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
3#
發表於 2017-12-19 18:34
| 只看該作者
本帖最後由 GBKEE 於 2017-12-21 17:37 編輯
回復 1# paul3063
試試看- Option Explicit
- Sub Ex_日收盤價及月平均收盤價()
- Dim oXmlhttp As Object, oHtmldoc As Object, surl, i, E, r As Double, c As Double
- Dim StockNo As String, xday As String, xRow As Integer, Day1 As Date, Day2 As Date, xTime As Date
- StockNo = [A2]
- Day1 = ActiveSheet.[B2]
- Day2 = ActiveSheet.[C2]
- For i = 0 To DateDiff("m", Day1, Day2)
- xday = Format(DateAdd("m", i, Day1), "yyyymmdd")
- Set oXmlhttp = CreateObject("msxml2.xmlhttp")
- Set oHtmldoc = CreateObject("htmlfile")
- surl = "http://www.twse.com.tw/exchangeReport/STOCK_DAY_AVG?response=html&date=" & xday & "&stockNo=" & StockNo
- With oXmlhttp
- .Open "Get", surl, False
- .Send
- If InStr(.responseText, "很抱歉,沒有符合條件的資料!") Then
- MsgBox "很抱歉,沒有符合條件的資料!" & vbLf & "請檢查 股票代號"
- Exit Sub
- ElseIf InStr(.responseText, "查詢日期小於88年1月5日,請重新查詢") Then
- MsgBox "查詢日期小於88年1月5日!" & vbLf & "請檢查 起始日期"
- Exit Sub
- ElseIf InStr(.responseText, "查詢日期大於今日,請重新查詢") Then
- MsgBox "查詢日期大於今日" & vbLf & "請檢查 終止日期"
- Exit Sub
- End If
- oHtmldoc.write .responseText
- End With
- With oHtmldoc
- Set E = .all.tags("table")(0)
- With ActiveSheet
- If i = 0 Then .UsedRange.Offset(2).Clear
- xRow = .Cells(Rows.Count, "a").End(xlUp).Row + IIf(i = 0, 1, 0)
-
- For r = IIf(i = 0, 0, 2) To E.Rows.Length - 2 '-1 可顯示月平均收盤價
- For c = 0 To E.Rows(r).Cells.Length - 1
- .Cells(xRow + r + IIf(i > 0, -1, 0), c + 1) = E.Rows(r).Cells(c).innertext
- Next
- Next
- End With
- End With
- Set oXmlhttp = Nothing
- Set oHtmldoc = Nothing
- Application.StatusBar = "**** " & Format(DateAdd("m", i, Day1), "ee/mm") & " 載完畢 *****"
- '**** 股市營業時間有流量管制 **
- 'xTime = Time + #12:00:09 AM# '間隔 10秒
- 'Do : DoEvents: Loop Until Time > xTime
- '**********或是下式**********************
- 'Application.Wait Now + #12:00:09 AM#
- '********************************
- Next
- MsgBox "ok"
- End Sub
複製代碼 |
|