|
- Sub today()
- Dim s$, objJSON As Object, o, arr(1 To 4000, 1 To 10), ar, i&, j%
- With CreateObject("MSXML2.XMLHTTP")
- .Open "GET", "http://datainterface.eastmoney.com/EM_DataCenter/JS.aspx?type=FD&sty=TSTC&ps=4000", False
- .Send
- s = Replace(Split(Split(.responsetext, "data:")(1), ",cdate")(0), "&sbquo", "")
- 'Debug.Print s
- End With
-
- With CreateObject("msscriptcontrol.scriptcontrol")
- .Language = "javaScript"
- .addcode "var lalal=" & s
- Set objJSON = .codeobject
- End With
-
- For Each o In objJSON.lalal
- i = i + 1
- ar = Split(o, ",")
- For j = 1 To UBound(ar) + 1
- arr(i, j) = ar(j - 1)
- Next
- Next
-
- With Sheet1
- .Cells.ClearContents
- .[a1].Resize(1, 10) = Array("′úÂë", "Ãû3Æ", "2»ÖaμàêÇé¶", "Ïà1Ø", "×îD¼Û", "ÕÇμø·ù", "»»êÖÂê", "êDóˉÂê", "Ö÷á|3é±¾", "»ú112ÎóëÂê")
- .Columns("A:A").NumberFormatLocal = "@"
- .[a2].Resize(i, UBound(ar) + 1) = arr
- End With
- With ActiveWorkbook.Worksheets("Sheet1").Sort
- .SortFields.Add Key:=Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
- .SetRange Range("A2:J" & i + 1)
- .Header = xlNo
- .MatchCase = False
- .Orientation = xlTopToBottom
- .SortMethod = xlPinYin
- .Apply
- End With
- End Sub
复制代码
|
评分
-
查看全部评分
|