怎么用VBA进行历史天气查询

1042271867

txh30603866 发表于 2023-8-9 09:54
Sub Get_Weather() '天气温度获取
    Dim xmlHttp As Object '创建对象
    Set xmlHttp = CreateObject ...

谢谢你啦，下标越标界   这句标黄：weather = Replace(Split(Split(Myhtml, "<i class=""wi wi-night-cloudy""> </i>")(1), "</span>")(0), Chr(10), "")

txh30603866

1042271867 发表于 2023-8-10 08:40
谢谢你啦，下标越标界   这句标黄：weather = Replace(Split(Split(Myhtml, " ")(1), "")(0), Chr(10), " ...

那没道理啊，我这正常的

txh30603866

1042271867 发表于 2023-8-10 08:40
谢谢你啦，下标越标界   这句标黄：weather = Replace(Split(Split(Myhtml, " ")(1), "")(0), Chr(10), " ...

OrientDate = "2023/5/1"‘这里是指定获取的日期
HtmlDate = Format(OrientDate, "YYYYMM")’这里是转换格式找到对应的月份网站
StrDate = Format(OrientDate, "YYYY-MM-DD")'这里是转换格式能跟网站上的日期匹配上
你是不是自己改了下，看看改对了没有

txh30603866

1042271867 发表于 2023-8-10 08:40
谢谢你啦，下标越标界   这句标黄：weather = Replace(Split(Split(Myhtml, " ")(1), "")(0), Chr(10), " ...

Sub Orient_Weather() '天气温度获取
    OrientDate = "2023/7/9"
    HtmlDate = Format(OrientDate, "YYYYMM")
    HtmlMonth = Format(OrientDate, "YYYY-MM")
    Dim xmlHttp As Object '创建对象
    Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
    xmlHttp.Open "GET", "https://lishi.tianqi.com/nantong/" & HtmlDate & ".html", False '发送请求
    xmlHttp.send
    Do While xmlHttp.ReadyState <> 4 '等待响应
    DoEvents
    Loop
    Dim Myhtml As String
    Myhtml = xmlHttp.responseText '得到请求数据
    Dim weather As String
   
    AllDate = Split(Myhtml, "<div class=""th200"">" & HtmlMonth & "-")
    For n = 1 To UBound(AllDate)
        ThisData = Split(AllDate(n), " 星期")(0)
        ThisData = HtmlMonth & "-" & ThisData
        weather = Split(Split(Myhtml, "<div class=""th200"">" & ThisData)(1), "</li>")(0)
        Weathers = Split(weather, "<div class=""th140"">")
        For i = 0 To UBound(Weathers)
            Weathers(i) = Split(Weathers(i), "</div>")(0)
        Next i
        Weathers(0) = Replace(Weathers(0), " ", "") '星期去除前后空格
        Debug.Print ThisData & " 当时星期：" & Weathers(0)
        Debug.Print ThisData & " 最高温度：" & Weathers(1)
        Debug.Print ThisData & " 最低温度：" & Weathers(2)
        Debug.Print ThisData & " 天气信息：" & Weathers(3)
        Debug.Print ThisData & " 风向风级：" & Weathers(4)
        
    Next n
End Sub
完整的获取每个月每天所有天气的代码，你自己把年份月份做个遍历就行了，目前来说还是好用的

1042271867

txh30603866 发表于 2023-8-10 10:47
Sub Orient_Weather() '天气温度获取
    OrientDate = "2023/7/9"
    HtmlDate = Format(OrientDate, ...

正常运行，但运行后没有输出结果。我用的是WPS、EXCEL2007测试的

1042271867

Sub Get_Weather() '天气温度获取
    Dim xmlHttp As Object '创建对象
    Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
    xmlHttp.Open "GET", "https://www.weaoo.com/zhenjiang-jurongshi-4833.html", False '发送请求
    xmlHttp.send
    Do While xmlHttp.readyState <> 4 '等待响应
    DoEvents
    Loop
    Dim Myhtml As String
    Myhtml = xmlHttp.responseText '得到请求数据
    Dim weather As String
    weather = Replace(Split(Split(Myhtml, "<i class=""wi wi-night-cloudy""> </i>")(1), "</span>")(0), Chr(10), "")
    Weathers = Split(Replace(weather, " ", ""), "/")
    MsgBox ("今日温度：" & Weathers(0))
End Sub

1042271867

这个代码可以获取温度，谢谢



Sub Get_Weather() '天气温度获取
    Dim xmlHttp As Object '创建对象
    Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
    xmlHttp.Open "GET", "https://www.weaoo.com/zhenjiang-jurongshi-4833.html", False '发送请求
    xmlHttp.send
    Do While xmlHttp.readyState <> 4 '等待响应
    DoEvents
    Loop
    Dim Myhtml As String
    Myhtml = xmlHttp.responseText '得到请求数据
    Dim weather As String
    weather = Replace(Split(Split(Myhtml, "<i class=""wi wi-night-cloudy""> </i>")(1), "</span>")(0), Chr(10), "")
    Weathers = Split(Replace(weather, " ", ""), "/")
    MsgBox ("今日温度：" & Weathers(0))
End Sub

1042271867

1042271867 发表于 2023-8-11 07:55
正常运行，但运行后没有输出结果。我用的是WPS、EXCEL2007测试的

这个能够获取当日天气温度，谢谢
Sub Get_Weather() '天气温度获取
    Dim xmlHttp As Object '创建对象
    Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
    xmlHttp.Open "GET", "https://www.weaoo.com/zhenjiang-jurongshi-4833.html", False '发送请求
    xmlHttp.send
    Do While xmlHttp.readyState <> 4 '等待响应
    DoEvents
    Loop
    Dim Myhtml As String
    Myhtml = xmlHttp.responseText '得到请求数据
    Dim weather As String
    weather = Replace(Split(Split(Myhtml, "<i class=""wi wi-night-cloudy""> </i>")(1), "</span>")(0), Chr(10), "")
    Weathers = Split(Replace(weather, " ", ""), "/")
    MsgBox ("今日温度：" & Weathers(0))
End Sub

txh30603866

1042271867 发表于 2023-8-11 08:00
这个能够获取当日天气温度，谢谢
Sub Get_Weather() '天气温度获取
    Dim xmlHttp As Object '创建对 ...

你不是获取过往天气的吗。。怎么在研究当日天气的代码。
wps可能稍微代码有点不一样，对网站的解析肯定是一样的。

笨笨的求知者

上班划水，从网站导出天所再查询