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

mojie0119

以下是修改后的代码，你先在单元格N1～N12输入对应的月份1～12，N1～N12允许为空值，空值代表不会查询对应月份的天气数据。



''''对应表格复制
Sub 历史天气2023()
   
   
    '创建对象
    Dim xmlHttp As Object, HTML As Object, Table As Object, oRows As Object, oCells As Object, i As Long, num As Long, m As Long, n As Long
    Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
    Set HTML = CreateObject("htmlfile")
    '发送请求
   
    num = 1
   
         Dim QueryYear As Integer
         Dim QueryMonth() As Variant
         Dim arr() As Variant
         Dim cnt As Integer
         For i = 1 To 12
         If Not IsEmpty(Range("N" & i)) Then
             ReDim Preserve arr(cnt)
             arr(cnt) = Range("N" & i).Value
             cnt = cnt + 1
         End If
        Next i
   
    QueryMonth = arr
    QueryYear = 2023 '要查询的年份
         
    For Each qm In QueryMonth
        '指定要查询的城市，修改城市所对应的编码
        'xmlHttp.Open "GET", "http://tianqi.2345.com/wea_history/71237.htm", False
        xmlHttp.Open "GET", "http://tianqi.2345.com/Pc/GetHistory?areaInfo%5BareaId%5D=71237&areaInfo%5BareaType%5D=2&date%5Byear%5D=" & QueryYear & "&date%5Bmonth%5D=" & qm, False
        xmlHttp.send
        '等待响应
        Do While xmlHttp.readyState <> 4
            DoEvents
        Loop
        '得到请求数据
        HTML.body.innerhtml = xmlHttp.responseText
   
        Set Table = HTML.getElementsByTagName("table")(0)

        With Table
            Set oRows = .Rows
            For m = 1 To oRows.Length - 1
                num = num + 1
                Set oCells = oRows(m).Cells
                For n = 0 To oCells.Length - 1
                    Cells(num, n + 1) = Replacestr(Convert(oCells(n).innerText))
                Next
               
            Next
        End With
    Next
   
    Set winhttp = Nothing
    Set HTML = Nothing
    Set Table = Nothing
    Set oRows = Nothing
    Set oCells = Nothing
   
    MsgBox "完成"
End Sub


Function Replacestr(strText As String) As String
    arrreplace = Array("</td>", "</tr>", "</span>", "</table>", "\n", "}", """", Chr(10))
    For Each Item In arrreplace
        Replacestr = Replace(strText, Item, "")
        strText = Replacestr
    Next
End Function

Function Convert(strText As String) As String

    With CreateObject("MSScriptControl.ScriptControl")
   
        .Language = "javascript"
        
        Convert = .Eval("('" & strText & "').replace(/&#\d+;/g,function(b){return String.fromCharCode(b.slice(2,b.length-1))});")
        
        Debug.Print Convert
   
    End With

End Function

yang1992820

perfect131 发表于 2023-8-12 15:47
pi话，vba 才是最简单，office自带 vbs更是系统自带， py则需要安装配置环境
py 用多线程时快，但写入ex ...

刚开始学Python Python真的好方便，各种第三方库，特别是各种加密算法的库都现成的

suzhouxiaozi

mojie0119 发表于 2023-11-1 22:04
以下是修改后的代码，你先在单元格N1～N12输入对应的月份1～12，N1～N12允许为空值，空值代表不会查询对应 ...

那如果需要跨年份查询需要怎么修改，比如需要22年到当前的天气的话

有点意思-

perfect131 发表于 2023-8-9 12:30
http://tianqi.2345.com/Pc/GetHistory?areaInfo[areaId]=60308&areaInfo[areaType]=2&date[year]=2023&dat ...

403  应该是被拒了

perfect131

有点意思- 发表于 2024-10-22 12:39
403  应该是被拒了

可能接口地址变了吧 或者需要ck