|
|
楼主 |
发表于 2017-10-7 19:38
|
显示全部楼层
本帖最后由 五指山888 于 2017-10-7 20:37 编辑
下面是模仿其他老师的，可是没用
Sub 金融街财经版() '20171005
Sheets("Sheet1").Select
Dim JsStr As String
Dim Js As String
Dim tmpStr As String
Dim i As Integer
Dim nPage As Byte
Dim nRow As Integer
ThisWorkbook.ActiveSheet.Cells.Clear
JsStr = "http://stock.jrj.com.cn/action/getTzrlData.jspa"
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "GET", JsStr, False
.setrequestheader "Referer", "http://stock.jrj.com.cn/tzrl/"
.send
JsStr = .responsetext
End With
tmpStr = JsStr & ";"
With CreateObject("MSScriptControl.ScriptControl")
.Language = "JScript"
.addcode tmpStr
nPage = .Eval("o.pages")
End With
nRow = 0
For i = 1 To nPage
JsStr = "http://stock.jrj.com.cn/action/getTzrlData.jspa"
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "GET", JsStr, False
.setrequestheader "Referer", "http://stock.jrj.com.cn/tzrl/"
.send
JsStr = .responsetext
End With
Js = "var r,k,row=c=1,d={};for(r in j){row++;for(k in j[r]){if(!d[k]){d[k]=c++;rng(1,d[k])=k;}rng(row,d[k])= j[r][k];}}"
Js = "j=" & Split(Split(JsStr, "data"":")(1), "}]")(0) & "}]" & ";" & Js
With CreateObject("MSScriptControl.ScriptControl")
.Language = "JScript"
.AddObject "rng", ThisWorkbook.ActiveSheet.Range("A" & nRow + 1)
.Eval (Js)
End With
If i <> 1 Then
With ThisWorkbook.ActiveSheet
.Rows(nRow + 1).Delete
nRow = .Range("A65536").End(xlUp).Row
End With
Else
nRow = ThisWorkbook.ActiveSheet.Range("A65536").End(xlUp).Row
End If
Next i
ThisWorkbook.ActiveSheet.Columns("A:R").AutoFit
End Sub |
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2017-10-2 23:08
