本帖最后由 2339083510 于 2017-2-10 14:43 編輯
http://www./thread-42824-1-1.html
非常感謝分享，研究你的帖子，我也大致上搞懂了excel采數(shù)據(jù)的一些思路，不過你的代碼太復(fù)雜，我也寫了一個(gè)，簡(jiǎn)化了一些（包含鏈接就發(fā)不出來(lái)，這個(gè)自己把"”%%%%%%%%%%%%%%%%%%"替換為鏈接就行了）
- Sub 運(yùn)用VBA提取網(wǎng)頁(yè)的基金信息到Excel工作表中()
- On Error GoTo ErrorHandler
- Dim re As Object, srg$, pos1%, pos2%, i%, j%
- Dim arr() As String, brr() As String, crr() As String, Rst(1 To 10000, 1 To 13)
- Application.ScreenUpdating = False
- '下載數(shù)據(jù)
- With CreateObject("Microsoft.XMLHTTP")
- .Open "get", "%%%%%%%%%%%%%%%%%%", False
- .send
- srg = .responsetext
- End With
- '提取標(biāo)題
- pos1 = InStr(srg, "<THEAD>") + Len("<THEAD>")
- pos2 = InStr(srg, "</THEAD>")
- arr = Split(Mid(srg, pos1, pos2 - pos1), "</td>")
- Set re = CreateObject("VBScript.RegExp")
- With re
- .Global = True
- .Pattern = "<[^>]+>|\s+"
- For i = 1 To 13
- Rst(1, i) = .Replace(arr(i + 1), "")
- Next
- End With
- '提取內(nèi)容
- brr = Split(Mid(srg, pos2, InStr(pos2, srg, "</table>")), "</tr>")
- With re
- For i = 0 To UBound(brr) - 7
- crr = Split(brr(i), "</td>")
- For j = 1 To 13
- If j = 1 Then
- Rst(i + 2, j) = "'" & .Replace(crr(j + 1), "")
- Else
- Rst(i + 2, j) = .Replace(crr(j + 1), "")
- End If
- Next
- Next
- End With
- '把數(shù)據(jù)寫入當(dāng)前工作表
- Cells.Clear
- [A1].Resize(i + 1, 13) = Rst
- Columns.AutoFit
- ErrorHandler:
- Set re = Nothing
- Erase arr, brr, crr, Rst
- Application.ScreenUpdating = True
- End Sub
|
