Board logo

標題: [原創] Excel VBA 期交所資料自訂日數查詢 [打印本頁]
作者: iamaraymond    時間: 2018-6-9 13:02     標題: Excel VBA 期交所資料自訂日數查詢

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

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

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

  3. Cells.Clear

  5. Dim myXML As Object
  6. Set myXML = CreateObject("WinHttp.WinHttpRequest.5.1")

  8. Dim myHTML As Object
  9. Set myHTML = CreateObject("HTMLFile")

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

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

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

  18. myCount = 0
  19. myDate = Date
  20. myNumber = InputBox("請輸入天數")
  21. With myXML
  22.    
  23.     Do
  24.         Application.Wait Now() + TimeValue("00:00:03")
  25.         myM = Format(Month(myDate), "00")
  26.         myD = Format(Day(myDate), "00")
  27.         
  28.         .Open "POST", "http://www.taifex.com.tw/chinese/3/3_1_1.asp", False
  29.         .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
  30.         .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="
  31.         
  32.         myHTML.body.innerHTML = convertraw(.responseBody)
  33.         'Debug.Assert InStr(1, myText, "10368") <> 0
  34.         
  35.         Set myTables = myHTML.getElementsByTagName("table")
  36.         i = 1
  37.         textRow = (myNumber - 1 - myCount) * 12 + 5
  38.         For Each myTable In myTables
  39.             If myTable.getAttribute("width") = 965 Then
  40.                
  41. '                textLR = Cells(myNumber * 12, "D")
  42. '                textLR = Cells(Rows.Count, "D").End(xlUp).Row
  43. '                textLR = IIf(textLR = 1, 5, textLR + 5)
  44.                 Cells(textRow, 4).Select
  45.                 Cells(textRow - 1, 4) = myTable.PreviousSibling.innerText
  46.                 Cells(textRow - 1, 4).WrapText = False
  47.                 With clipboard
  48.                     .SetText myTable.outerHTML
  49.                     .PutInClipboard
  50.                 End With
  51.                 Sheets("工作表1").PasteSpecial NoHTMLFormatting:=False
  52.                 myCount = myCount + 1
  53.                
  54.                 Exit For
  55.             End If
  56.         Next
  57.         myDate = myDate - 1
  58.     Loop Until myCount = CInt(myNumber)
  59. End With
  60. Application.StatusBar = "查詢筆數:" & myNumber & "筆"
  61. Range("A2") = "資料範圍"
  62. Range("A3") = Split(Split(Cells((myNumber - myCount) * 12 + 4, "D"), "：")(1), "臺")(0) & "~" & Split(Split(Cells((myNumber - 1) * 12 + 4, "D"), "：")(1), "臺")(0)

  64. Set myXML = Nothing

  66. End Sub
  67. Function convertraw(rawdata)

  69. Dim rawstr
  70. Set rawstr = CreateObject("adodb.stream")
  71. With rawstr
  72. .Type = 1
  73. .Mode = 3
  74. .Open
  75. .Write rawdata
  76. .Position = 0
  77. .Type = 2
  78. .Charset = "UTF-8"
  79. convertraw = .ReadText
  80. .Close
  81. End With
  82. Set rawstr = Nothing

  84. End Function
複製代碼
[attach]28807[/attach]



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)