如何使用vba从网页中提取单一数据

2025-03-10 04:42:01
推荐回答(3个)
回答1:

以下代码能将第一网站的融资融券余额提取放在当前工作表的A1单元格中。你用一下,如果明后天也能使用,说明网站数据结构是固定的,那我再给你做提取第二个网站的。需要的话就追问一下。

Sub 提取融资融券余额()
   Set xm = CreateObject("Msxml2.XMLHTTP.3.0")
   xm.Open "GET", "http://www.szse.cn/main/disclosure/rzrqxx/rzrqjy/", False
   xm.send
   s = StrConv(xm.responsebody, vbUnicode)
   [A1] = Val(Replace(Split(s, "class='cls-data-td'  align='right' >")(6), ",", ""))
End Sub

回答2:

Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Integer, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Integer, ByVal lpfnCB As Integer) As Long
Sub getdata()
url = "http://www.szse.cn/szseWeb/FrontController.szse?ACTIONID=8&CATALOGID=1837_xxpl&tab2PAGENUM=1&ENCODE=1&TABKEY=tab1"
'url = StrConv(url, vbUnicode)
'DoFileDownload url
fpath = ThisWorkbook.Path & "\1.xls"
URLDownloadToFile 0, url, fpath, 0, 0
Application.ScreenUpdating = False
Workbooks.Open fpath
ActiveWorkbook.Sheets(1).Range("a1:f2").Copy
ThisWorkbook.Sheets(1).Range("a1:f2").PasteSpecial xlPasteAll
ActiveWorkbook.Close
Kill fpath
Application.ScreenUpdating = True
End Sub

这是第一个网站的数据,数据在第一个表的a1:f2,原理是从它提供的地址下载xls文件,然后打开复制粘贴到vba所在xls文件,由于不知道地址是否固定,所以不知道明天是否能用,请测试;第二个网站类似,请尝试照葫芦画瓢。

回答3:

Sub cc()

Cells.ClearContents

Set oDoc = CreateObject("htmlfile")

With CreateObject("WinHttp.WinHttpRequest.5.1")

.Open "GET",
"http://www.wzyunying.com/transparent.do?method=spxlList&tasktype=xb&nowYearM=2014-04&acceptid=&applyTypeCde=IND&isTimetag=0&pageMaxNumber=360&pagenum=1",
False

.Send

.WaitForResponse

oDoc.body.innerHTML = .responsetext

Set r = oDoc.All.tags("table")(7).Rows

For i = 0 To r.Length - 1

k = [a65536].End(3).Row

For j = 0 To r(i).Cells.Length - 1

Cells(k + 1, j + 1) = r(i).Cells(j).innerText

Next j

Next i

Set r = Nothing

End With

End Sub