需要 用 到 统计用区划和城乡划分代码 数据，可以 国家统计局的是一个个页面，需要把数据爬出来。
哎，想当年VBA 写了那么多东西，现在连定义数组，变量赋值都忘了怎么弄，无奈边写边查，总算整出来一个能用的代码。
----------------------------------------------------------------------------------------------------
Sub rtrv_Click()
Dim ie, dmt, bd, i As Integer, k As Integer, m As Long, n As Long, q As Long
Set ie = CreateObject("InternetExplorer.Application") '创建一个IE对象
With ie
.Visible = False '显示它
'处理省
.navigate "http://www.stats.gov.cn/tjsj/tjbz/tjyqhdmhcxhfdm/2015/index.html" '加载某个页面
Do Until .readyState = 4 '等待页面加载完毕
DoEvents
Loop
Set dmt = .Document '将IE浏览器加载的页面文档，赋予dmt变量
'开始操纵页面，或者提取数据啦
Set trs = dmt.body.all.tags("tr")
i = 0
For Each tr In trs
If (InStr(1, tr.className, "provincetr") > 0 And tr.all.tags("a").Length > 0) Then
Set aes = tr.all.tags("a")
For Each a In aes
i = i + 1
Sheet3.Cells(i, 2) = "'" & Left(Right(a.getAttribute("href"), 7), 2)
Sheet3.Cells(i, 1) = a.innerText
Sheet3.Cells(i, 3) = a.getAttribute("href")
Next
End If
Next
k = 0
'处理城市
For index = 1 To i
.navigate Sheet3.Cells(index, 3)
Do Until .readyState = 4 '等待页面加载完毕
DoEvents
Loop
Set dmt = .Document
Set trs = dmt.body.all.tags("tr")
For Each tr In trs
If (InStr(1, tr.className, "citytr") > 0 And tr.all.tags("a").Length > 0) Then
k = k + 1
Sheet4.Cells(k, 1) = "'" & tr.all.tags("td")(0).innerText
Sheet4.Cells(k, 2) = tr.all.tags("td")(1).innerText
Sheet4.Cells(k, 3) = tr.all.tags("a")(0).getAttribute("href")
End If
Next
Next
m = 0
'处理县
For index = 1 To k
.navigate Sheet4.Cells(index, 3)
Do Until .readyState = 4 '等待页面加载完毕
DoEvents
Loop
Set dmt = .Document
Set trs = dmt.body.all.tags("tr")
For Each tr In trs
If (InStr(1, tr.className, "countytr") > 0 And tr.all.tags("a").Length > 0) Then
m = m + 1
Sheet5.Cells(m, 1) = "'" & tr.all.tags("td")(0).innerText
Sheet5.Cells(m, 2) = tr.all.tags("td")(1).innerText
Sheet5.Cells(m, 3) = tr.all.tags("a")(0).getAttribute("href")
End If
Next
Next
n = 0
'处理镇
For index = 1 To m
.navigate Sheet5.Cells(index, 3)
Do Until .readyState = 4 '等待页面加载完毕
DoEvents
Loop
Set dmt = .Document
Set trs = dmt.body.all.tags("tr")
For Each tr In trs
If (InStr(1, tr.className, "towntr") > 0 And tr.all.tags("a").Length > 0) Then
n = n + 1
Sheet6.Cells(n, 1) = "'" & tr.all.tags("td")(0).innerText
Sheet6.Cells(n, 2) = tr.all.tags("td")(1).innerText
Sheet6.Cells(n, 3) = tr.all.tags("a")(0).getAttribute("href")
End If
Next
Next
q = 0
'处理村
For index = 1 To n
.navigate Sheet6.Cells(index, 3)
Do Until .readyState = 4 '等待页面加载完毕
DoEvents
Loop
Set dmt = .Document
Set trs = dmt.body.all.tags("tr")
For Each tr In trs
If (InStr(1, tr.className, "villagetr") > 0) Then
q = q + 1
Sheet7.Cells(q, 1) = "'" & tr.all.tags("td")(0).innerText
Sheet7.Cells(q, 2) = tr.all.tags("td")(1).innerText
Sheet7.Cells(q, 3) = tr.all.tags("td")(2).innerText
End If
Next
Next
End With
End Sub