json数据处理不会弄了（by：YZC51 ）

俊锋伍贰零 · 发表于 2015-10-26 19:59

本帖最后由俊锋伍贰零于 2015-10-27 05:34 编辑

json数据处理不会弄了，请高手们点拨一下，谢谢。

Sub test()
Dim winhttp, URL, arr2(), i, p, t1, t2, k, pages, arr1, d, code
Dim aa, x, y As Object, s, Cell, j, ar, liebiao, n
Dim arr(1 To 158, 1 To 33)

Sheet1.Cells.Clear                   '清除内容
Set winhttp = CreateObject("WinHttp.WinHttpRequest.5.1")
Application.ScreenUpdating = False
Application.DisplayStatusBar = True

With winhttp
URL = "http://fundata.jnlc.com/SitePages/Layouts/JNPJFeature/search.ashx?qt=FundPrice&iFundID=0&strTailIndex=0&strTermType=0&t=2015-10-23&strActStyle=0&strInvestType=0&begindate=2015-10-23&enddate=2015-10-23&shareType=&strIfAOn=%E6%98%AF&strInvestCode=×tamp=1445855402095&_search=false&nd=1445855402106&rows=30&page=1&sidx=dPriceIncrease&sord=desc "
.Open "GET", URL, False
.setRequestHeader "Connection", "Keep-Alive"
.send
t = .responsetext
With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")    '调试用，数据放入剪贴板
.SetText t
.PutInClipboard
End With
'Debug.Print t
'Stop
With x
Set x = CreateObject("ScriptControl")
x.Language = "JScript"
s = "function getjson(s) { return eval('(' + s + ')'); }"
x.addcode s
Set y = x.codeobject.getjson(t)
Debug.Print y
'Stop

For Each p In CallByName(CallByName(y, "rows", VbGet), "cell", VbGet)  ‘不会弄了
n = n + 1
arr1 = Split(p, ",")
Cells(n, 1).Resize(1, UBound(arr) + 1) = arr
Next
End With
End With
Set winhttp = Nothing
Set arr1 = Nothing
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub

--------------------------------------------------------------------------
到了这就不会弄了，期待高手点拨一下。O(∩_∩)O谢谢！

YZC51 · 发表于 2015-10-27 00:06

请参考

Sub YZC51()
Dim objxml As New WinHttpRequest, url$, str$
'url = "http://www.okooo.com/ajax/shahao/P3/20/N1/"
url = "http://fundata.jnlc.com/SitePages/Layouts/JNPJFeature/search.ashx?qt=FundPrice&iFundID=0&strTailIndex=0&strTermType=0&t=2015-10-23&strActStyle=0&strInvestType=0&begindate=2015-10-23&enddate=2015-10-23&shareType=&strIfAOn=%E6%98%AF&strInvestCode=&timestamp=1445855402095&_search=false&nd=1445855402106&rows=30&page=1&sidx=dPriceIncrease&sord=desc"
With objxml
.Open "GET", url, False
.setRequestHeader "Referer", "http://www.okooo.com/p3/p3sh/"
.send
strt = "|" & .responseText
End With
str = Split(Split(strt, "[{")(1), "]}]}")(0)
str = Replace(str, "id", Chr(10))
str = Replace(str, ",", Chr(9))
Set reg = CreateObject("vbscript.regexp") 'ÕýÔò
'str = StrReverse(str)'Äæ»·
reg.Global = True
reg.Pattern = "[a-zC-Z"":,{}]"
str = reg.Replace(str, "")
Debug.Print str
With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
.SetText str
.PutInClipboard
End With
Range("A2").Select
ActiveSheet.Paste
End Sub

复制代码

俊锋伍贰零 · 发表于 2015-10-27 05:29

非常感谢您的及时解答，这个是我电脑的问题吗？怎么提示出错了么。。。。。

俊锋伍贰零 · 发表于 2015-10-27 05:32

http://club.excelhome.net/thread-874446-1-1.html
行了解决了，O(∩_∩)O哈哈~

YZC51 · 发表于 2015-10-27 16:46

不客气，解决就好！！！！

WYS67 · 发表于 2018-9-21 18:14

YZC51 发表于 2015-10-27 00:06
请参考

老师：我想把冷码的过程加载宏，把《冷码YZC51》里有关的代码，复制粘贴到新建的《冷码》时，“开始计算”选择框对应的是《冷码YZC51》3111模块里的“冷码”，“选择框”对应的是《冷码YZC51》模块1里的：

Sub 按钮2_Click()
UserForm1.Show 0

End Sub

吗?把这两个代码复制粘贴到一个新的工作簿里，点击按钮运行时，为什么出错？
《冷码YZC51》里有多个过程，试过后都无法在《冷码》中运行！

恳请老师帮忙，只把和“冷码”关联的代码复制粘贴进《冷码》对应的模块里，并作一讲解。

冷码的代码复制粘贴.zip (860.65 KB, 下载次数: 7)

		自动登录	找回密码
密码			免费注册

[已解决] json数据处理不会弄了（by：YZC51 ）

评分

评分