- ©«¤l
- 109
- ¥DÃD
- 12
- ºëµØ
- 0
- ¿n¤À
- 177
- ÂI¦W
- 0
- §@·~¨t²Î
- win10
- ³nÅ骩¥»
- office2013
- ¾\ŪÅv
- 20
- ©Ê§O
- ¨k
- ¨Ó¦Û
- °ª¶¯
- µù¥U®É¶¡
- 2017-11-19
- ³Ì«áµn¿ý
- 2023-7-5
|
¦^´_ 9# bhsm - Sub test()
- stockno = InputBox("½Ð¿é¤JªÑ²¼¥N¸¹")
- If stockno = "" Then Exit Sub
- Application.ScreenUpdating = False
- [A4].CurrentRegion.Clear
- t = Timer
- Dim myXML As Object
- Set myXML = CreateObject("WinHttp.WinHttpRequest.5.1")
- Dim myHTML As Object
- Set myHTML = CreateObject("HTMLFile")
- myLimit = 10 'ªñ´Xµ§¸ê®Æ¼Æ
- ReDim myDateArr(1 To 60, 1 To 1)
- ReDim myValArr(1 To 25, 1 To myLimit * 5)
- With myXML
- .Open "POST", "https://www.tdcc.com.tw/smWeb/QryStockAjax.do", False '¥ý§ì¨ú¤é´Á
- .setRequestHeader "Content-type", "application/x-www-form-urlencoded;charset=UTF-8"
- .send "REQ_OPR=qrySelScaDates"
-
- k = 1
- For Each myText2 In Split(.responseText, ",")
- myDateArr(k, 1) = Replace(Replace(Replace(myText2, Chr(34), ""), "[", ""), "]", "")
- k = k + 1
- Next
-
- mycount = 1
- For Each myDate In myDateArr
- retry:
- .Open "POST", "https://www.tdcc.com.tw/smWeb/QryStockAjax.do", False '¥N¤J¤é´Á¼´¸ê®Æ
- .setRequestHeader "Content-type", "application/x-www-form-urlencoded"
- .send "scaDates=" & myDate & "&scaDate=" & myDate & "&SqlMethod=StockNo&StockNo=" & stockno & "&StockName=&REQ_OPR=SELECT&clkStockNo=" & stockno & "&clkStockName="
-
- If InStr(1, .responseText, "µL¦¹¸ê®Æ") <> 0 Then GoTo retry
-
- myHTML.body.innerHTML = .responseText
-
- Set mytable = myHTML.getElementsByTagName("table")(7)
-
- i = 1
-
- For Each myRow In mytable.Rows
-
- j = 5 * (myLimit - mycount) + 1
- For Each myCell In myRow.Cells
- myValArr(i, j) = myCell.innerText
- j = j + 1
- Next
- i = i + 1
- Next
- Cells(4, j - 5) = myDate
- Debug.Assert Cells(4, j - 4) = ""
- mycount = mycount + 1
- If mycount = myLimit + 1 Then Exit For 'n§ì´Xµ§¸ê®Æ
- Next
- [A3] = "ÃÒ¨é¦WºÙ¡G" & Split(Split(.responseText, "ÃÒ¨é¦WºÙ¡G")(1), "<")(0)
- [A5].Resize(UBound(myValArr), 5 * myLimit).Value = myValArr
- End With
- Erase myDateArr
- Erase myValArr
- Set myXML = Nothing
- Set myHTML = Nothing
- Debug.Print Format(Timer - t, "0.00’")
- Application.ScreenUpdating = True
- End Sub
½Æ»s¥N½X ¸Õ¬Ý¬Ý³oÓ§a~ |
|