vba 抓取 统计用区划和城乡划分代码 到 电子表格

 

需要 用 到 统计用区划和城乡划分代码  数据，可以 国家统计局的是一个个页面，需要把数据爬出来。

 

哎，想当年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