[已解决]网页搜到的天气预报

我心飞翔410

http://lishi.tianqi.com/jiangjin/201111.html  他格式是这样的啊 我想原样弄到excel里面怎么弄啊 求解

最佳答案

月排行榜 / 总排行榜

JLxiangwei

2012-11-26 18:00

Sub test()
    Dim ie, dmt, div, ul, i&, j&
    On Error Resume Next
    Set ie = CreateObject("InternetExplorer.Application")
    With ie
        .Visible = False
        .navigate "http://lishi.tianqi.com/jiangjin/201111.html"
        Do Until .ReadyState = 4
            DoEvents
        Loop
        Set dmt = .document
    End With
    Set div = dmt.all.tags("div")(37)
    Range("a1").Offset(65536, 10).ClearContents
    For i = 0 To div.Children.Length - 1
        Set ul = div.Children(i)
        For j = 0 To ul.Children.Length - 2
            Cells(i + 1, j + 1) = ul.Children(j).innertext
        Next
    Next
End Sub

提取天气.zip (10.95 KB, 下载次数: 38)

2012-11-26 18:44 上传

点击文件名下载附件
由于网站架构已经更改，所以代码更新一下

Sub test()
    Dim ie, dmt, div, ul, i&, j&
    On Error Resume Next
    Set ie = CreateObject("InternetExplorer.Application")
    With ie
        .Visible = False
        .navigate "http://lishi.tianqi.com/jiangjin/201111.html"
        Do Until .ReadyState = 4
            DoEvents
        Loop
        Set dmt = .document
    End With
    Set div = dmt.all.tags("div")(38)
    For i = 0 To div.Children.Length - 1
        Set ul = div.Children(i)
        For j = 0 To ul.Children.Length - 2
            Cells(i + 1, j + 1) = ul.Children(j).innertext
        Next
    Next
End Sub

跳转到最佳答案楼层

JLxiangwei

Sub test()
    Dim ie, dmt, div, ul, i&, j&
    On Error Resume Next
    Set ie = CreateObject("InternetExplorer.Application")
    With ie
        .Visible = False
        .navigate "http://lishi.tianqi.com/jiangjin/201111.html"
        Do Until .ReadyState = 4
            DoEvents
        Loop
        Set dmt = .document
    End With
    Set div = dmt.all.tags("div")(37)
    Range("a1").Offset(65536, 10).ClearContents
    For i = 0 To div.Children.Length - 1
        Set ul = div.Children(i)
        For j = 0 To ul.Children.Length - 2
            Cells(i + 1, j + 1) = ul.Children(j).innertext
        Next
    Next
End Sub

提取天气.zip (10.95 KB, 下载次数: 38)

2012-11-26 18:44 上传

点击文件名下载附件
由于网站架构已经更改，所以代码更新一下

Sub test()
    Dim ie, dmt, div, ul, i&, j&
    On Error Resume Next
    Set ie = CreateObject("InternetExplorer.Application")
    With ie
        .Visible = False
        .navigate "http://lishi.tianqi.com/jiangjin/201111.html"
        Do Until .ReadyState = 4
            DoEvents
        Loop
        Set dmt = .document
    End With
    Set div = dmt.all.tags("div")(38)
    For i = 0 To div.Children.Length - 1
        Set ul = div.Children(i)
        For j = 0 To ul.Children.Length - 2
            Cells(i + 1, j + 1) = ul.Children(j).innertext
        Next
    Next
End Sub