利用Excel VBA批量计算气象数据多个台站多年来春季和冬季降水量和平均气温

       气象数据是地理数据的重要组成部分，存储量虽然不大，但是处理过程非常繁琐，长时序数据更不用说。本文总结了一个气象数据的基本处理方法。

       如下图所示，气象数据的排列格式是区站号→年→月→降水量→平均气温，时间范围为1983~2012年，每一年都有台站数300多个，下面按区站号+年的格式来求降水量和平均气温



1、求春季降水量和气温

       春季一般认为是当年的3,4,5月份，下面我们借助Excel VBA+ADO.NET，编写宏代码来实现：

Sub admin()
Dim conn, xRs, SQL, xFd, year
year = InputBox("请输入一个数", "输入")
If year = "" Then
Exit Sub
End If
If year > 2012 Or year < 1983 Then
MsgBox "你想不想混了？", vbOKOnly, "哼"
Exit Sub
End If

Set conn = CreateObject("ADODB.Connection")
conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
Set xRs = CreateObject("ADODB.RecordSet")

sSql = " Select 区站号, avg(降水量) From [Sheet1$A:E] where 月 in(3,4,5) and 年=" & year & "  group by 区站号,年 order by 区站号"
xRs.Open sSql, conn, 1, 3
Sheet1.Cells(1, 6).Value = year + "年"
Sheet1.Cells(1, 7).Value = year + "年降水量"
Sheet1.Range("F2").CopyFromRecordset xRs
xRs.Close

sSql = " Select  avg(平均气温) From [Sheet1$A:E] where 月 in(3,4,5) and 年=" & year & "  group by 区站号,年 order by 区站号"
xRs.Open sSql
Sheet1.Cells(1, 8).Value = year + "年均气温"
Sheet1.Range("H2").CopyFromRecordset xRs
xRs.Close

conn.Close
Set xRs = Nothing
Set conn = Nothing
End Sub

处理的结果如上图的F→H列所示。

2、求冬季降水量和平均气温

       冬季一般认为是当年1,2月份和前一年12月份，处理的思路是先求出当年1,2月份的降水量很平均气温，再找出前一年12月份降水量和气温，再汇总。代码如下：

Sub admin()
    Dim conn, xRs, SQL, xFd, year
    year = InputBox("请输入一个数", "输入")
    If year = "" Then
        Exit Sub
    End If
    If year > 2012 Or year < 1983 Then
        MsgBox "你想不想混了？", vbOKOnly, "哼"
        Exit Sub
    End If
    
    '连接字符串
    Set conn = CreateObject("ADODB.Connection")
    conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
    Set xRs = CreateObject("ADODB.RecordSet")
    
    '计算当年1,2月份的降水量
    sSql = " Select 区站号, avg(降水量) From [Sheet1$A:E] where 月 in(1,2) and 年=" & year & "  group by 区站号,年 order by 区站号"
    xRs.Open sSql, conn, 1, 3
    Sheet1.Cells(1, 6).Value = year + "年"
    Sheet1.Cells(1, 7).Value = year + "年降水量_1,2月"
    Sheet1.Range("F2").CopyFromRecordset xRs
    xRs.Close
    
    '计算前一年12月份的降水量
    sSql = "Select avg(降水量) From [Sheet1$A:E] where 月 =12 and 年=" & Str(year - 1) & "  group by 区站号,年 order by 区站号"
    xRs.Open sSql
    Sheet1.Cells(1, 8).Value = Str(year - 1) + "年12月降水量"
    Sheet1.Range("H2").CopyFromRecordset xRs
    xRs.Close
    
    '计算当年1,2月份的平均气温
    sSql = " Select  avg(平均气温) From [Sheet1$A:E] where 月 in(1,2) and 年=" & year & "  group by 区站号,年 order by 区站号"
    xRs.Open sSql
    Sheet1.Cells(1, 10).Value = year + "年均气温_1,2月"
    Sheet1.Range("J2").CopyFromRecordset xRs
    xRs.Close
    
    '计算前一年12月份的气温
    sSql = " Select  avg(平均气温) From [Sheet1$A:E] where 月 =12 and 年=" & Str(year - 1) & "  group by 区站号,年 order by 区站号"
    xRs.Open sSql
    Sheet1.Cells(1, 11).Value = Str(year - 1) + "年12月气温"
    Sheet1.Range("K2").CopyFromRecordset xRs
    xRs.Close
    
    '汇总降水量
    Cells(1, "I").Value = "降水量汇总"
    For i = 2 To Sheet1.Range("G2").End(xlDown).Row
        Cells(i, "I") = WorksheetFunction.Average(Cells(i, "G"), Cells(i, "H"))
    Next
    
    '汇总平均气温
    Cells(1, "L").Value = "平均气温汇总"
    For j = 2 To Sheet1.Range("J2").End(xlDown).Row
        Cells(j, "L") = WorksheetFunction.Average(Cells(j, "J"), Cells(j, "K"))
    Next
    
    '关闭所有连接，释放资源
    conn.Close
    Set xRs = Nothing
    Set conn = Nothing
End Sub

运行结果如下图所示：



注意：

1、计算冬季时由于用到了前一年的数据，在计算起始年（1983年）时，缺少1982年的数据，计算结果为空。

2、如果某些台站有缺失年份数据，计算结果会有误！

3、注意Excel 2013所能处理的有效行数。