|
楼主 |
发表于 2017-4-18 11:21
|
显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
大神
现在出现了各新问题,数据存在重复现象,每个数据都有两个一样的
能再帮忙看下代码吗
十分感谢- Sub 按钮1_Click()
- Set oDom = CreateObject("htmlfile")
- Set oWin = oDom.parentWindow
- oWin.execScript
- jsonpcallback = oWin.eval("'jsonpCallback' + Math.floor(Math.random() * (100000 + 1))")
- t = oWin.eval("new Date().getTime()")
- URL = "http://query.sse.com.cn/infodisplay/queryBltnBookInfo.do?jsonCallBack=" & jsonpcallback & "&isPagination=true&isNew=1&bulletintype=L013&publishYear=2017&cmpCode=&startTime=&sortName=companyCode&direction=asc&pageHelp.pageSize=1500&pageHelp.pageCount=1&pageHelp.pageNo=1&pageHelp.beginPage=1&pageHelp.cacheSize=1&pageHelp.endPage=1&_=" & t
- Cells(1, 1) = jsonpcallback
- Cells(1, 4) = t
- Set objXML = CreateObject("WinHttp.WinHttpRequest.5.1")
- With objXML
- .Open "GET", URL, False
- .setRequestHeader "Referer", "http://www.sse.com.cn/disclosure/listedinfo/periodic/"
- .send
- Cells(3, 1) = .Status
- txtcontent = .responsetext
- End With
- arrT1 = Split(txtcontent, ",{")
- Cells(3, 3) = UBound(arrT1)
- Cells(4, 1) = "披露时间"
- Cells(4, 2) = "报告类型"
- Cells(4, 3) = "股票名称"
- Cells(4, 4) = "股票代码"
- Cells(4, 5) = "不明"
- Cells(4, 6) = "首次预约时间"
- Cells(4, 7) = "一次变更日"
- Cells(4, 8) = "二次变更日"
- Cells(4, 9) = "三次变更日"
- Cells(4, 10) = "披露年份"
- Cells(4, 11) = "不明"
- For i = 1 To UBound(arrT1)
- arrT2 = Split(arrT1(i), ",")
- Cells(3, 6) = UBound(arrT2)
- For j = 0 To UBound(arrT2)
- arrT2(j) = Mid(arrT2(j), InStrRev(arrT2(j), ":") + 2)
- Next j
- Cells(i + 4, 1) = arrT2(1)
- Cells(i + 4, 2) = arrT2(2)
- Cells(i + 4, 3) = arrT2(3)
- Cells(i + 4, 4) = arrT2(4)
- Cells(i + 4, 5) = arrT2(5)
- Cells(i + 4, 6) = arrT2(6)
- Cells(i + 4, 7) = arrT2(7)
- Cells(i + 4, 8) = arrT2(8)
- Cells(i + 4, 9) = arrT2(9)
- Cells(i + 4, 10) = arrT2(10)
- Cells(i + 4, 11) = arrT2(11)
- Next i
- Cells.Replace What:="ull", Replacement:="", LookAt:=xlPart, SearchOrder _
- :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
- Cells.Replace What:=Chr(34), Replacement:="", LookAt:=xlPart, SearchOrder _
- :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
- Cells.Replace What:="}", Replacement:="", LookAt:=xlPart, SearchOrder _
- :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
- Cells.Replace What:="]", Replacement:="", LookAt:=xlPart, SearchOrder _
- :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
- Cells.Columns.AutoFit
- End Sub
复制代码 |
|