楼主
xmyjk |
Q:如何用VBA 收集理想论坛荐股大赛的的各参赛会员的荐股（标签【参赛会员】）以及排名（标签【成绩排名】）。
链接：http://www.55188.com/viewthread.php?tid=4686774&extra=page%3D1%26amp%3Bfilter%3Dtype%26amp%3Btypeid%3D153
就是：
如何通过VBA把该贴中楼主首贴【参赛会员】（有205个）和【成绩排名】（有90个）下的各信息收集到两个工作表中（见附件）。注意默认只加载了一部分，浏览网页时拖动鼠标才会加载其余的部分。怎么才能VBA读取所有的记录（这里分别是205个和90个）？
A:通过抓包分析工具，得知，可通过以下两个链接，取得数据：
http://www.55188.com/viewthread.php?tid=4686774&ajaxlist=5&begin=0&loop=500
http://www.55188.com/viewthread.php?tid=4686774&ajaxlist=6&begin=0&loop=500
获取参赛会员的代码：- Option Explicit
- Sub test()
- Dim tmp() As String, i As Integer, arr() As String, xmlhttp As Object, N As Long
- [A1].CurrentRegion.Offset(1).Clear
- Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
- With xmlhttp
- .Open "get", "http://www.55188.com/viewthread.php?tid=4686774&ajaxlist=5&begin=0&loop=500", False
- .send
- tmp = Filter(Split(Replace(Replace(Replace(.responsetext, "<div", "<td class="), "</div>", "</td>"), "</a>", ""), "</td>"), "<td class=")
- End With
- ReDim arr(UBound(tmp) \ 6, 5)
- For i = 0 To UBound(tmp)
- arr(i \ 6, i Mod 6) = Split(tmp(i), ">")(UBound(Split(tmp(i), ">")))
- Next
- [a2].Resize(UBound(arr) + 1, UBound(arr, 2) + 1) = arr
- [a:e].Columns.AutoFit
- Erase tmp
- Erase arr
- Set xmlhttp = Nothing
-
- MsgBox "Ok"
- End Sub
获取比赛成绩的代码：- Option Explicit
- Sub test1()
- Dim tmp() As String, i As Integer, arr() As String, xmlhttp As Object, N As Long
- [A1].CurrentRegion.Offset(1).Clear
- Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
- With xmlhttp
- .Open "get", "http://www.55188.com/viewthread.php?tid=4686774&ajaxlist=6&begin=0&loop=500", False
- .send
- tmp = Filter(Split(Replace(Replace(Replace(Replace(Replace(Replace(.responsetext, "</span>", ""), "<td class=""pid"">", ""), "<br /><span>", vbCrLf), "<div", "<td class="), "</div>", "</td>"), "</a>", ""), "</td>"), "<td class=")
- End With
- ReDim arr(UBound(tmp) \ 9, 8)
- For i = 0 To UBound(tmp)
- arr(i \ 9, i Mod 9) = Split(tmp(i), ">")(UBound(Split(tmp(i), ">")))
- Next
- [a2].Resize(UBound(arr) + 1, UBound(arr, 2) + 1) = arr
- [a:e].Columns.AutoFit
- Erase tmp
- Erase arr
- Set xmlhttp = Nothing
- MsgBox "Ok"
- End Sub
 理想论坛.zip
|
厉害，学习了！