ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[­ì³Ð] Excel VBA ´Á¥æ©Ò¸ê®Æ¦Û­q¤é¼Æ¬d¸ß

[­ì³Ð] Excel VBA ´Á¥æ©Ò¸ê®Æ¦Û­q¤é¼Æ¬d¸ß

¥»©«³Ì«á¥Ñ iamaraymond ©ó 2018-6-9 13:04 ½s¿è

Excel VBAºô­¶¸ê®Æ¦¬¶°±Ð¾Ç:
http://forum.twbts.com/thread-20848-1-1.html

¦¹µ{¦¡¬O±N¤W¦¸ªºµo¤åµy·L§ï¹L¡A¥i¥H¿é¤J·Q­n¬d¸ßªº¤Ñ¼Æ
¦pªG·Q©T©w¬d¸ß¯S©w¤Ñ¼Æ¤]¥i¥Hª½±µ±Ninputbox¨º¤@¦æ§ï±¼
  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("½Ð¿é¤J¤Ñ¼Æ")
  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("¤u§@ªí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 = "¬d¸ßµ§¼Æ:" & myNumber & "µ§"
  54. Range("A2") = "¸ê®Æ½d³ò"
  55. Range("A3") = Split(Split(Cells((myNumber - myCount) * 12 + 4, "D"), "¡G")(1), "»O")(0) & "~" & Split(Split(Cells((myNumber - 1) * 12 + 4, "D"), "¡G")(1), "»O")(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
½Æ»s¥N½X
´Á¥æ©Ò¸ê®Æ¦Û­q¤é¼Æ¬d¸ß.zip (41.05 KB)
Excel VBAºô­¶¸ê®Æ¦¬¶°±Ð¾Ç:
http://forum.twbts.com/thread-20848-1-1.html

        ÀR«ä¦Û¦b : «Ý¤H°h¤@¨B¡A·R¤H¼e¤@¤o¡A´N·|¬¡±o«Ü§Ö¼Ö¡C
ªð¦^¦Cªí ¤W¤@¥DÃD