抓取天气网站历史数据！

关纭 · 发表于 2015-10-20 14:25

求助~我希望从http://tianqi.2345.com/wea_history/59287.htm涉及到广州的2015年天气信息记录在excel里面，希望各位大侠帮忙，可以的话把解释标注一下。。。不想单纯的抄袭。。但找了很久资料又没有方向。。。当然手动是可以。但是我是需要多个城市的资料以及定期更新，手动粘贴太。。。

关纭 · 发表于 2015-10-20 15:43

有人帮忙吗。。。。。。

YZC51 · 发表于 2015-10-20 22:25

请测试

Sub Weather()
Dim strText As String
Cells.Clear
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "http://www.tianqihoubao.com/weather/top/guangzhou.html", False
.setRequestHeader "Connection", "keep-alive"
.Send
strText = .responsetext
strText = "<table" & Split(Split(strText, "<table")(1), "</table>")(0) & "</table>"
With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
.SetText strText
.PutInClipboard
End With
Range("A1").Select
ActiveSheet.Paste
End With
End Sub

复制代码

amzxfgh9632 · 发表于 2015-10-20 23:06

YZC51 发表于 2015-10-20 22:25
请测试

http://www.tianqihoubao.com/yubao/beijing.html 含图片和表头不知道能不能做哦

YZC51 · 发表于 2015-10-20 23:31

请教！出现这些乱码，怎么修改！

Application.ScreenUpdating = 0
Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
With xmlhttp
.Open "get", "http://tianqi.2345.com/t/wea_history/js/59287_201510.js", False
.send
t = .responsetext
t1 = Replace(Split(Split(t, "[{ymd:")(1), "{}]")(0), "ymd:", Chr(10))
t1 = Replace(t1, "',", ",")
End With
Debug.Print Left(t1, 2000) '& Right(t1, 2000)
With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
.SetText t1
.PutInClipboard
End With
With ActiveSheet
.[a4].Select
.Paste
.[a4:a35].TextToColumns Destination:=Range("a4"), Comma:=True
End With
Set winhttp = Nothing
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub

复制代码

YZC51 · 发表于 2015-10-20 23:38

amzxfgh9632 发表于 2015-10-20 23:06
http://www.tianqihoubao.com/yubao/beijing.html 含图片和表头不知道能不能做哦

谢谢加分！我也是才学网抓！试试看！

amzxfgh9632 · 发表于 2015-10-20 23:42

YZC51 发表于 2015-10-20 23:38
谢谢加分！我也是才学网抓！试试看！

http://www.15tianqi.com/beijing/抓这个15天的，要含图片哦

YZC51 · 发表于 2015-10-20 23:58

amzxfgh9632 发表于 2015-10-20 23:06
http://www.tianqihoubao.com/yubao/beijing.html 含图片和表头不知道能不能做哦

请测试！先来无图片的！有图片的还在学习研究下！

Sub Weather_forecast() 'http://www.tianqihoubao.com/lishi/guangzhou/month/201509.html
Dim strText As String
Cells.Clear
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "http://www.tianqihoubao.com/yubao/beijing.html", False
.setRequestHeader "Connection", "keep-alive"
.send
strText = .responsetext
[a1] = Split(Split(strText, "<h1>")(1), "</h1>")(0)
[a2] = "数据为" & Split(Split(strText, "数据为")(1), "</div>")(0)
strText = "<table" & Split(Split(strText, "<table")(1), "</table>")(0) & "</table>"
strText = Replace(strText, "img src='/legend/", "")
With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
.SetText strText
.PutInClipboard
End With
Range("A3").Select
ActiveSheet.Paste
End With
End Sub

复制代码

YZC51 · 发表于 2015-10-21 00:45

amzxfgh9632 发表于 2015-10-20 23:42
http://www.15tianqi.com/beijing/抓这个15天的，要含图片哦

来个简单的先！好困啦！改日再学习着做一下

Sub Weather_forecast15() 'http://www.tianqihoubao.com/lishi/guangzhou/month/201509.html
'http://www.15tianqi.com/beijing/
Dim strText As String
Cells.Clear
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "http://www.15tianqi.com/beijing/", False
.setRequestHeader "Connection", "keep-alive"
.send
strText = .responsetext
[a1] = Split(Split(strText, "<h1>")(1), "</h1>")(0)
strText = Split(Split(strText, "未来15天天气预报★")(1), "由15tianqi.com")(0)
strText = Replace(strText, ":" & Chr(13) & Chr(10), Chr(9))
strText = Replace(strText, Chr(13) & Chr(10), "")
strText = Replace(Replace(strText, "，", Chr(9)), " ", "")
Debug.Print strText
With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
.SetText strText
.PutInClipboard
End With
Range("A2").Select
ActiveSheet.Paste
'[a3:a35].TextToColumns Destination:=Range("a3"), Comma:=True
End With
End Sub

复制代码

关纭 · 发表于 2015-10-21 10:01

YZC51 发表于 2015-10-20 22:25
请测试

我想在http://tianqi.2345.com/wea_history/59287.htm这个网站下载数据。。。并且可以拿到历史月份的数据。。

		自动登录	找回密码
密码			免费注册

[已解决] 抓取天气网站历史数据！

评分

评分

最新热点 /1

[已解决] 抓取 天气网站 历史数据！

评分

评分

最新热点 /1

[已解决] 抓取天气网站历史数据！