Excel | 运用VBA提取网页数据的一个实例 | 网页,数据,信息,提取,基金

 本帖最后由 2339083510 于 2017-2-10 14:43 编辑
http://www./thread-42824-1-1.html

非常感谢分享，研究你的帖子，我也大致上搞懂了excel采数据的一些思路，不过你的代码太复杂，我也写了一个，简化了一些（包含链接就发不出来，这个自己把"”%%%%%%%%%%%%%%%%%%"替换为链接就行了）

1. Sub 运用VBA提取网页的基金信息到Excel工作表中()
   
2.     On Error GoTo ErrorHandler
   
3.     Dim re As Object, srg$, pos1%, pos2%, i%, j%
   
4.     Dim arr() As String, brr() As String, crr() As String, Rst(1 To 10000, 1 To 13)
   
5.     Application.ScreenUpdating = False
   
6. 
   
7.     '下载数据
   
8.     With CreateObject("Microsoft.XMLHTTP")
   
9.         .Open "get", "%%%%%%%%%%%%%%%%%%", False
   
10.         .send
    
11.         srg = .responsetext
    
12.     End With
    
13. 
    
14.     '提取标题
    
15.     pos1 = InStr(srg, "<THEAD>") + Len("<THEAD>")
    
16.     pos2 = InStr(srg, "</THEAD>")
    
17.     arr = Split(Mid(srg, pos1, pos2 - pos1), "</td>")
    
18.     Set re = CreateObject("VBScript.RegExp")
    
19.     With re
    
20.         .Global = True
    
21.         .Pattern = "<[^>]+>|\s+"
    
22.         For i = 1 To 13
    
23.             Rst(1, i) = .Replace(arr(i + 1), "")
    
24.         Next
    
25.     End With
    
26. 
    
27.     '提取内容
    
28.     brr = Split(Mid(srg, pos2, InStr(pos2, srg, "</table>")), "</tr>")
    
29.     With re
    
30.         For i = 0 To UBound(brr) - 7
    
31.             crr = Split(brr(i), "</td>")
    
32.             For j = 1 To 13
    
33.                 If j = 1 Then
    
34.                     Rst(i + 2, j) = "'" & .Replace(crr(j + 1), "")
    
35.                 Else
    
36.                     Rst(i + 2, j) = .Replace(crr(j + 1), "")
    
37.                 End If
    
38.             Next
    
39.         Next
    
40.     End With
    
41. 
    
42.     '把数据写入当前工作表
    
43.     Cells.Clear
    
44.     [A1].Resize(i + 1, 13) = Rst
    
45.     Columns.AutoFit
    
46. ErrorHandler:
    
47.     Set re = Nothing
    
48.     Erase arr, brr, crr, Rst
    
49.     Application.ScreenUpdating = True
    
50. End Sub

复制代码