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

王三哥

在原来的代码基础上做了修改

注意，如果是要查询往年的，需要修改对应年份和月份部分

QueryYear = 2023 '要查询的年份
QueryMonth = Array(1, 2, 3, 4, 5, 6, 7, 8) '要查询的月份

王三哥

在原来的代码基础上做了修改

注意，如果是要查询往年的，需要修改对应年份和月份部分

QueryYear = 2023 '要查询的年份
QueryMonth = Array(1, 2, 3, 4, 5, 6, 7, 8) '要查询的月份

nwtcctv

用python搞岂不是更简单。


import requests
from bs4 import BeautifulSoup as bs
import pandas as pd
from pandas import Series,DataFrame
headers={'User-Agent': 'Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/104.0.5112.102 Safari/537.36 Edg/104.0.1293.63',
        'Host':'lishi.tianqi.com',
        'Accept-Encoding': "gzip, deflate",
        'Connection': "keep-alive",
        'cache-control': "no-cache"}   
url='https://lishi.tianqi.com/shenyang/202208.html'
resp= requests.request("GET", url, headers=headers)
resp.encoding = 'utf-8'
soup = bs(resp.text,'html.parser')
data_all=[]
tian_three=soup.find("div",{"class":"tian_three"})
lishitable_content=tian_three.find_all("li")
for i in lishitable_content:
    lishi_div=i.find_all("div")
    data=[]
    for j in lishi_div:
        data.append(j.text)
    data_all.append(data)
weather=pd.DataFrame(data_all)
weather.columns=["当日信息","最高气温","最低气温","天气","风向信息"]
weather_shape=weather.shape
weather['当日信息'].apply(str)
result = DataFrame(weather['当日信息'].apply(lambda x:Series(str(x).split(' '))))
result=result.loc[:,0:1]
result.columns=['日期','星期']
weather['风向信息'].apply(str)
result1 = DataFrame(weather['风向信息'].apply(lambda x:Series(str(x).split(' '))))
result1=result1.loc[:,0:1]
result1.columns=['风向','级数']
weather=weather.drop(columns='当日信息')
weather=weather.drop(columns='风向信息')
weather.insert(loc=0,column='日期', value=result['日期'])
weather.insert(loc=1,column='星期', value=result['星期'])
weather.insert(loc=5,column='风向', value=result1['风向'])
weather.insert(loc=6,column='级数', value=result1['级数'])
weather.to_csv("XX的天气.csv",encoding="utf_8")

nwtcctv

用python岂不是更快更简单

import requests
from bs4 import BeautifulSoup as bs
import pandas as pd
from pandas import Series,DataFrame
headers={'User-Agent': 'Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/104.0.5112.102 Safari/537.36 Edg/104.0.1293.63',
        'Host':'lishi.tianqi.com',
        'Accept-Encoding': "gzip, deflate",
        'Connection': "keep-alive",
        'cache-control': "no-cache"}   
url='https://lishi.tianqi.com/shenyang/202208.html'
resp= requests.request("GET", url, headers=headers)
resp.encoding = 'utf-8'
soup = bs(resp.text,'html.parser')
data_all=[]
tian_three=soup.find("div",{"class":"tian_three"})
lishitable_content=tian_three.find_all("li")
for i in lishitable_content:
    lishi_div=i.find_all("div")
    data=[]
    for j in lishi_div:
        data.append(j.text)
    data_all.append(data)
weather=pd.DataFrame(data_all)
weather.columns=["当日信息","最高气温","最低气温","天气","风向信息"]
weather_shape=weather.shape
weather['当日信息'].apply(str)
result = DataFrame(weather['当日信息'].apply(lambda x:Series(str(x).split(' '))))
result=result.loc[:,0:1]
result.columns=['日期','星期']
weather['风向信息'].apply(str)
result1 = DataFrame(weather['风向信息'].apply(lambda x:Series(str(x).split(' '))))
result1=result1.loc[:,0:1]
result1.columns=['风向','级数']
weather=weather.drop(columns='当日信息')
weather=weather.drop(columns='风向信息')
weather.insert(loc=0,column='日期', value=result['日期'])
weather.insert(loc=1,column='星期', value=result['星期'])
weather.insert(loc=5,column='风向', value=result1['风向'])
weather.insert(loc=6,column='级数', value=result1['级数'])
weather.to_csv("XX的天气.csv",encoding="utf_8")

perfect131

nwtcctv 发表于 2023-8-12 08:35
用python搞岂不是更简单。

pi话，vba 才是最简单，office自带 vbs更是系统自带， py则需要安装配置环境
py 用多线程时快，但写入excel很慢，整体就很慢了。vba 在excel中执行 ，所以读写自然最快
获取源码处理 写入结果 vba 0.7秒，所以 请不要 过度吹捧py


py

松野

暴力拆解

松野

中国天气网福建站96个城市未来7天天气爬取

nwtcctv

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

非常抱歉！我没说vba有什么不好，各有各的优势，vba我也经常用

mojie0119

王三哥 发表于 2023-8-11 21:38
在原来的代码基础上做了修改

注意，如果是要查询往年的，需要修改对应年份和月份部分

如何能自动判断当前月份N，再根据当前月份自动抓取1～N月份的天气数据。

因为一旦QueryMonth = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 11, 12)，月份超过当前月份，比如现在是11月，我这个代码要抓取从1～12的所有天气数据，但当前没有12月份的天气数据，就会有错误提示。

mojie0119

以下是我修改后的代码，先在单元格N1～N12输入你要查询的月份数，N1～N12分别对应1～12，允许为空值，空值则不会查询对应月份的天气数据。所以你可以根据自己的需要提取本年度随意一个月或者几个月的天气数据。



''''对应表格复制
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