返回列表 上一主題 發帖

[原創] Excel VBA 期交所資料自訂日數查詢

[原創] Excel VBA 期交所資料自訂日數查詢

本帖最後由 iamaraymond 於 2018-6-9 13:04 編輯

Excel VBA網頁資料收集教學:
http://forum.twbts.com/thread-20848-1-1.html

此程式是將上次的發文稍微改過,可以輸入想要查詢的天數
如果想固定查詢特定天數也可以直接將inputbox那一行改掉
  1. Sub test()

  2. Cells.Clear

  3. Dim myXML As Object
  4. Set myXML = CreateObject("WinHttp.WinHttpRequest.5.1")

  5. Dim myHTML As Object
  6. Set myHTML = CreateObject("HTMLFile")

  7. Dim clipboard As Object
  8. Set clipboard = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

  9. ReDim myArr(1 To 10, 1 To 20)

  10. dateLR = Cells(Rows.Count, "A").End(xlUp).Row

  11. myCount = 0
  12. myDate = Date
  13. myNumber = InputBox("請輸入天數")
  14. With myXML
  15.    
  16.     Do
  17.         Application.Wait Now() + TimeValue("00:00:03")
  18.         myM = Format(Month(myDate), "00")
  19.         myD = Format(Day(myDate), "00")
  20.         
  21.         .Open "POST", "http://www.taifex.com.tw/chinese/3/3_1_1.asp", False
  22.         .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
  23.         .send "qtype=2&commodity_id=TX&commodity_id2=&market_code=0&goday=&dateaddcnt=0&DATA_DATE_Y=2018&DATA_DATE_M=05&DATA_DATE_D=22&syear=2018&smonth=" & myM & "&sday=" & myD & "&datestart=2018%2F05%2F15&MarketCode=0&commodity_idt=TX&commodity_id2t=&commodity_id2t2="
  24.         
  25.         myHTML.body.innerHTML = convertraw(.responseBody)
  26.         'Debug.Assert InStr(1, myText, "10368") <> 0
  27.         
  28.         Set myTables = myHTML.getElementsByTagName("table")
  29.         i = 1
  30.         textRow = (myNumber - 1 - myCount) * 12 + 5
  31.         For Each myTable In myTables
  32.             If myTable.getAttribute("width") = 965 Then
  33.                
  34. '                textLR = Cells(myNumber * 12, "D")
  35. '                textLR = Cells(Rows.Count, "D").End(xlUp).Row
  36. '                textLR = IIf(textLR = 1, 5, textLR + 5)
  37.                 Cells(textRow, 4).Select
  38.                 Cells(textRow - 1, 4) = myTable.PreviousSibling.innerText
  39.                 Cells(textRow - 1, 4).WrapText = False
  40.                 With clipboard
  41.                     .SetText myTable.outerHTML
  42.                     .PutInClipboard
  43.                 End With
  44.                 Sheets("工作表1").PasteSpecial NoHTMLFormatting:=False
  45.                 myCount = myCount + 1
  46.                
  47.                 Exit For
  48.             End If
  49.         Next
  50.         myDate = myDate - 1
  51.     Loop Until myCount = CInt(myNumber)
  52. End With
  53. Application.StatusBar = "查詢筆數:" & myNumber & "筆"
  54. Range("A2") = "資料範圍"
  55. Range("A3") = Split(Split(Cells((myNumber - myCount) * 12 + 4, "D"), ":")(1), "臺")(0) & "~" & Split(Split(Cells((myNumber - 1) * 12 + 4, "D"), ":")(1), "臺")(0)

  56. Set myXML = Nothing

  57. End Sub
  58. Function convertraw(rawdata)

  59. Dim rawstr
  60. Set rawstr = CreateObject("adodb.stream")
  61. With rawstr
  62. .Type = 1
  63. .Mode = 3
  64. .Open
  65. .Write rawdata
  66. .Position = 0
  67. .Type = 2
  68. .Charset = "UTF-8"
  69. convertraw = .ReadText
  70. .Close
  71. End With
  72. Set rawstr = Nothing

  73. End Function
複製代碼
期交所資料自訂日數查詢.zip (41.05 KB)
Excel VBA網頁資料收集教學:
http://forum.twbts.com/thread-20848-1-1.html

        靜思自在 : 【時間成就一切】時間可以造就人格,可以成就事業,也可以儲積功德。
返回列表 上一主題