Excel怎么抓取网络数据？

网友解答: Excel抓取并查询网络数据可以使用“获取和转换”+“查找引用函数”的功能组合来实现。例：下图是百度百科“奥运会”网页中的一个表格，我们以此为例实现抓取该表格至Excel中，

Excel抓取并查询网络数据可以使用“获取和转换”+“查找引用函数”的功能组合来实现。

例：下图是百度百科“奥运会”网页中的一个表格，我们以此为例实现抓取该表格至Excel中，并且能够通过输入第几届来查询对应的举办城市。

依次点击“数据选项卡”、“新建查询”、“从其他源”、“从Web”。

弹出如下窗口，手动将百度百科“奥运会”的网址复制粘入URL栏，并点击确定。

Excel与网页连接需要一定时间，稍等片刻后会弹出如下窗口，左边列表中的每个Table都代表该网页中的一个表格，挨个点击预览后发现，Table3是我们所需的数据。

点开下方的“加载”旁边的下拉箭头，选择“加载到”。

在弹出的窗口中，在“选择想要在工作薄中查看此数据的方式”下选择“表”，并点击加载。

如图，网页表格中的数据已被抓取至Excel中。

依次点击“表格工具”、“设计”，将“表名称”改为奥运会。

建立查询区域，包含“届数”和“主办城市”，在届数中随意选取一届输入，下图输入“第08届”，在主办城市下输入vlookup函数，可以得到第08届奥运会的主办城市是巴黎，当更改届数时，对应的主办城市也随之变动。

公式：=VLOOKUP([届数],奥运会[#全部],4,0)

注意点：若网页中的数据变动较频繁，则可以设置链接网页的数据定时刷新：

①将鼠标定位于导入的数据区域中，切换到【设计】选项卡，点击【刷新】下拉箭头→【链接属性】

②在弹出的【链接属性】对话框中，设置【刷新频率】，比如设置为10分钟进行刷新。这样，每隔10分钟数据就会刷新一次，时刻保证获取的数据位最新的。

大家好,我是@Excel实例视频网站长@欢迎私信或者邀请我回答Excel相关问题!

有人在群里问手机号怎么批量查归属地，第一感觉是百度一下，结果还真没找到好用的，既然如此，我就自己写一个吧！首先找了几个webapi，找到个挺好用的，就用vba写了个自定义函数，测试下感觉还是挺好用，速度也挺快

使用方法：

1.在本表中直接在A1列输入手机号即可

2.要在其他表中，alt+f11打开vbe编辑器，复制模块中代码,在你的新表中建立模块，粘贴代码即可

3.函数参数说明

GetPhoneInfo(号码,参数)

号码—即单个手机号

参数（1,2,3,4）：1-城市，2-省，3-运营商, 4-全部

代码如下

Dim ObjXML As Object

Function GetPhoneInfo(number, Optional para As Byte = 1)

'获取手机号对应的基本信息 默认为城市

'para:1-城市，2-省，3-运营商,4,全部

Dim s As String

s = GetBody("http://v.showji.com/Locating/showji.com2016234999234.aspx?output=json&callback=querycallback&m=" & number)

Select Case para

Case 1

GetPhoneInfo = HtmlFilter(s, "City"":""", """")

Case 2

GetPhoneInfo = HtmlFilter(s, "Province"":""", """")

Case 3

GetPhoneInfo = HtmlFilter(s, "TO"":""", """")

Case 4

GetPhoneInfo = HtmlFilter(s, "City"":""", """") & "," & HtmlFilter(s, "Province"":""", """") & "," & HtmlFilter(s, "TO"":""", """")

End Select

GetPhoneInfo = Replace(GetPhoneInfo, " ", "")

End Function

Private Sub Test()

Dim i&, j&, k&, arr, brr

url = "http://v.showji.com/Locating/showji.com2016234999234.aspx?output=json&callback=querycallback&m=15698151655"

Debug.Print GetBody(url)

End Sub

'''如果出现乱码，UTF-8可改为GB2312

Public Function GetBody(ByVal url$, Optional ByVal Coding$ = "utf-8")

On Error Resume Next

Set ObjXML = CreateObject("Microsoft.XMLHTTP")

With ObjXML

.Open "Get", url, False, "", ""

'.setRequestHeader "If-Modified-Since", "0"

'.setRequestHeader "User-Agent", _

".Mozilla/5.0 (Windows NT 6.1; WOW64; rv:47.0) Gecko/20100101 Firefox/47.0"

.Send

GetBody = .ResponseBody

End With

GetBody = BytesToBstr(GetBody, Coding)

Set ObjXML = Nothing

End Function

Public Function BytesToBstr(strBody, CodeBase)

Dim ObjStream

Set ObjStream = CreateObject("Adodb.Stream")

With ObjStream

.Type = 1: .Mode = 3: .Open:

.Write strBody: .Position = 0: .Type = 2: .Charset = CodeBase

BytesToBstr = .ReadText: .Close

End With

Set ObjStream = Nothing

End Function

Public Function HtmlFilter(ByVal htmlText$, ByVal Label1$, ByVal label2$)

'返回html字符串lable1和最近的lable2标签中的数据

Dim pStart As Long, pStop As Long

pStart = InStr(htmlText, Label1) + Len(Label1)

If pStart < 0 Then

pStop = InStr(pStart, htmlText, label2)

HtmlFilter = Mid(htmlText, pStart, pStop - pStart)

End If

End Function