Excel怎么抓取網絡數據？
網友解答: Excel抓取并查詢網絡數據可以使用“獲取和轉換”+“查找引用函數”的功能組合來實現。例：下圖是百度百科“奧運會”網頁中的一個表格，我們以此為例實現抓取該表格至Excel中，
Excel抓取并查詢網絡數據可以使用“獲取和轉換”+“查找引用函數”的功能組合來實現。
例：下圖是百度百科“奧運會”網頁中的一個表格，我們以此為例實現抓取該表格至Excel中，并且能夠通過輸入第幾屆來查詢對應的舉辦城市。
Step1：使用“獲取和轉換”功能將網絡數據抓取至Excel中依次點擊“數據選項卡”、“新建查詢”、“從其他源”、“從Web”。
彈出如下窗口，手動將百度百科“奧運會”的網址復制粘入URL欄，并點擊確定。
Excel與網頁連接需要一定時間，稍等片刻后會彈出如下窗口，左邊列表中的每個Table都代表該網頁中的一個表格，挨個點擊預覽后發現，Table3是我們所需的數據。
點開下方的“加載”旁邊的下拉箭頭，選擇“加載到”。
在彈出的窗口中，在“選擇想要在工作薄中查看此數據的方式”下選擇“表”，并點擊加載。
如圖，網頁表格中的數據已被抓取至Excel中。
依次點擊“表格工具”、“設計”，將“表名稱”改為奧運會。
Step2：使用“查找與引用”函數實現數據查詢建立查詢區域，包含“屆數”和“主辦城市”，在屆數中隨意選取一屆輸入，下圖輸入“第08屆”，在主辦城市下輸入vlookup函數，可以得到第08屆奧運會的主辦城市是巴黎，當更改屆數時，對應的主辦城市也隨之變動。
公式：=VLOOKUP([屆數],奧運會[#全部],4,0)
注意點：若網頁中的數據變動較頻繁，則可以設置鏈接網頁的數據定時刷新：
①將鼠標定位于導入的數據區域中，切換到【設計】選項卡，點擊【刷新】下拉箭頭→【鏈接屬性】
②在彈出的【鏈接屬性】對話框中，設置【刷新頻率】，比如設置為10分鐘進行刷新。這樣，每隔10分鐘數據就會刷新一次，時刻保證獲取的數據位最新的。
「精進Excel」系酷米簽約作者，關注我，如果任意點開三篇文章，沒有你想要的知識，算我耍流氓！ 網友解答:
大家好,我是@Excel實例視頻網站長@歡迎私信或者邀請我回答Excel相關問題!
有人在群里問手機號怎么批量查歸屬地，第一感覺是百度一下，結果還真沒找到好用的，既然如此，我就自己寫一個吧！首先找了幾個webapi，找到個挺好用的，就用vba寫了個自定義函數，測試下感覺還是挺好用，速度也挺快
源文件下載鏈接請私信回復63005即可使用方法：
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