Excelで気象庁の降水量・気温10分データを自動的に取得する

環境の研究には気象データが欠かせません。気象庁は過去のデータを公開していますが、例えば１０分データを１年分取得するとなると一仕事ですよね。Excelの「データの取得」とVBAを使えば簡単に長期間のデータを取得できます。

第一章「自動化の方法の見つけ方」では、気象庁データを例に一般論としての自動化の方法の見つけ方を説明します。１０分データがすぐにでも欲しい人は第二章「降水量・気温10分データを自動的に取得するExcel VBAプログラム」から読んでください。

なお、気象庁ホームページのコンテンツの利用規約については「気象庁ホームページについて」を確認してください。2022年11月24日時点で自動データ収集を制限する記述はありませんが、気象庁ホームページに過度な負荷をかけないよう、良識を持って利用しましょう。

自動化の方法の見つけ方

気象庁ホームページのしくみ

気象庁の過去の気象データ検索のページで地点と年月日を選択することで、１日単位で１０分毎の降水量・気温・風速などのデータを表示させることができます。

下図は２０２２年８月１日の宇部のデータを表示させたものです。

この時のURLに注目してみましょう。赤字で示した81と0778が場所を示しており、2022, 8, 1で日付を示していることがわかります。つまり、このURLを生成してやれば目的の気象データがワンステップで表示されることになります。

なお、URLだけで場所と日時を指定できないWebサイトも多くあります。そのような時にはPower Automateの使用を検討してください。

ExcelでWebデータを取得するしくみ

Excelの①「データ」リボンで②「Webから」をクリックし、現れたダイアログに先ほどの③URLをコピペしてみましょう。④「OK」をクリックするとWebコンテンツへのアクセスダイアログが現れるので、⑤「接続」をクリックします。現れたナビゲーターダイアログの左側には、URLのWebページに含まれるテーブルのリストが表示されていますので、欲しいデータが含まれている⑥テーブルを選択すると右側にテーブルの内容が表示されます。

上図⑦「読み込み」ボタンを押すと、下図のようにデータがExcelにテーブルとして読み込まれます。右側の「クエリと接続」サイドバーには読み込みに使われたクエリが表示されています。

右側のクエリの部分をクリックすることで再度読み込みが実行されますので、同じURLでデータが更新されていくようなページでは、クエリごとExcelファイルを保存しておけばワンクリックで最新データが取得できます。今回の気象データは地点と日にちをURLで指定しなければならないので、そうはいきませんね。

ExcelでWebデータを取得する手順をマクロコード化する方法

Webデータ取得を自動化する第一歩として、前節の処理の流れを「マクロの記録」で記録してみましょう。同じ名称のクエリを２つ作成することはできませんので、一旦Excelを閉じ、新しくExcelで空白のブックを開きます。①「開発」リボンを開き、②「マクロの記録」をクリックして、「マクロの記録」ダイアログで③「OK」を選びます。

ここから「データ」リボンに戻って前節の通り作業し、気象データがExcelに表示されたら「開発」リボンに戻って④「記録終了」をクリックし、最後に⑤「Visual Basic」をクリックします。

下図のVisual Basicウインドウ左上のプロジェクトエクスプローラーで「標準モジュール」を展開し、①Module1をダブルクリックすると、右側にModule1のコードが表示されます。難しそうなコードですが、入力したURLが②の部分に記述されていることがわかります。つまり、ここを適切に書き換えれば自動的に任意地点の複数日のデータを取得することも可能になるはずです！

降水量・気温10分データを自動的に取得するExcel VBAプログラム

ここで紹介するプログラムは、必要最低限のものです。データが存在しない等の理由でデータ取得に失敗して途中停止することもありますが、そういったエラー対策は一切行っていません。また、あらゆる条件でテストしたわけでもありませんし、最善のコードとも限りません。必要に応じて皆さんで工夫してください。

１日分の10分データを取得するVBAプログラム fetchJMA10min1day

以下に、指定の場所の指定の日付の10分気象データをExcelに取り込むVBA関数を示します。引数１と２で地点を、引数３，４，５で日付を、引数６でカラム名を付与するかどうかを指定します。

②のクエリの作成が核心部で、上で述べたURLの地点と日付を引数で与え、気温や雨量などの数値データを文字ではなく数値として読み込むように設定しています。（その結果、雨量などの数値データのカラムに文字が含まれていると空白になってしまいます。）

①、⑥のクエリの削除は、同じ名前のクエリは複数存在できないために行っています。④のテーブル削除も、同じテーブル名ではデータが読めないためです。⑦は、最終行の24:00:00の時刻が読み込まれていないためにプログラム内で付与しています。⑧で日付のカラムを作成しています。⑨ではこの関数を連続実行した時にデータが下に追加されるよう、読み込んだデータの最終行の次にActiveCellを移動しています。

Option Base 1
Option Explicit

Sub fetchJMA10min1day(prec As String, block As String, year As Integer, month As Integer, day As Integer, header As Boolean)
'
' 気象庁(JMA)の過去データからprec, blockで表される観測局のyear年month月day日の10分毎降水量、気温、湿度、風速、日照時間を読み出す。
' headerがTrueならカラム名を付加、Falseならカラム名を付加しない。

' ①念のために既存のクエリの削除
    Dim qry As WorkbookQuery
    For Each qry In ActiveWorkbook.Queries
        qry.Delete
    Next
' ②クエリの作成
    Dim Url As String
    Url = """https://www.data.jma.go.jp/obd/stats/etrn/view/10min_a1.php?prec_no=" & prec & "&block_no=" & block & "&year=" & Trim(Str(year)) & "&month=" & Trim(Str(month)) & "&day=" & Trim(Str(day)) & "&view="""
    
    ActiveWorkbook.Queries.Add Name:="work", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    ソース = Web.Page(Web.Contents(" & Url & "))," & Chr(13) & "" & Chr(10) & "    Data0 = ソース{0}[Data]," & Chr(13) & "" & Chr(10) & "    変更された型 = Table.TransformColumnTypes(Data0,{{""時分"", type time}, {""降水量 (mm)"", type number}, {""気温 (℃)"", type number}, {""相対湿度 (％)"", type number}, {""風向・風速 平均 風速(m/s)"", type number}," & _
        " {""風向・風速 平均 風向"", type text}, {""風向・風速 最大瞬間 風速(m/s)"", type number}, {""風向・風速 最大瞬間 風向"", type text}, {""日照 時間 (min)"", type number}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    変更された型" & _
        ""

' ③クエリの実行
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""work"";Extended Properties=""""" _
        , Destination:=ActiveCell).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [work]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = False
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "work"
        .Refresh BackgroundQuery:=False
    End With
    
' ④テーブル解除
    ActiveSheet.ListObjects("work").Unlist

' ⑤不要なヘッダ行を削除
    If header Then
        ActiveCell.Offset(1, 0).Rows("1:3").EntireRow.Delete Shift:=xlUp
    Else
        ActiveCell.Offset(0, 0).Rows("1:4").EntireRow.Delete Shift:=xlUp
    End If

' ⑥クエリを削除
    For Each qry In ActiveWorkbook.Queries
        qry.Delete
    Next

' ⑦空欄になっている最終行の時刻に24:00:00を入力
    Dim iRowStart
    Dim iRowCount
    Dim iRowEnd
    Dim iColStart
    
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.Offset(1, 0)).Select
    iRowStart = Selection.Row
    iRowCount = Selection.Rows.Count
    iRowEnd = iRowCount + iRowStart - 1
    iColStart = Selection.Column
    Cells(iRowEnd, iColStart).Value = "1/1/1900  12:00:00 AM"
    
' ⑧１カラム目に日付を挿入
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Dim d As Date
    d = Trim(Str(year)) & "/" & Trim(Str(month)) & "/" & Trim(Str(day))
    Selection.Value = d

' ⑨連続読み出しに備えて最終行の次にカーソル移動
    Selection.End(xlDown).Offset(1, 0).Select

End Sub

以下はこの関数を呼び出すメインプログラムの例です。2021年1月2日から3日までの２日間のデータを読み出しています。なお、別の地点を表すコードの探し方は上ですだくんが話しています。

Sub example1()
' 気象庁(JMA)の過去データからprec, blockで表される観測局の2021年1月2日～3日の10分毎降水量、気温、湿度、風速、日照時間を読み出す。

    Dim i As Integer
    For i = 2 To 3
      Call fetchJMA10min1day("81", "0778", 2021, 1, i, False)
    Next i
End Sub

１か月分の10分データを取得するVBAプログラム fetchJMA10min1month

以下に、指定の場所の指定の年月の10分気象データを１か月分Excelに取り込むVBA関数を示します。引数１と２で地点を、引数３，４で年月を、引数６でカラム名を付与するかどうかを指定します。

内部で１日のデータを読む関数を使用していますので、前節の関数も読み込んでおかなければなりません。

Sub fetchJMA10min1month(prec As String, block As String, year As Integer, month As Integer, header As Boolean)
'
' 気象庁(JMA)の過去データからprec, blockで表される観測局のyear年month月の10分毎降水量、気温、湿度、風速、日照時間を読み出す。
' headerがTrueならカラム名を付加、Falseならカラム名を付加しない。
    
    Dim i As Integer
    Dim dayInMonth As Variant
    Dim firstMonth As Boolean
    Dim hd As Boolean

' ひと月の日数定義
    dayInMonth = Array(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
    If (day(DateSerial(year, 3, 1) - 1) = 29) Then
        dayInMonth(2) = 29
    End If
    
    firstMonth = True
    For i = 1 To dayInMonth(month)
        If firstMonth And header Then
          hd = True
          firstMonth = False
        Else
          hd = False
        End If
        Call fetchJMA10min1day(prec, block, year, month, i, hd)
    Next i
End Sub

以下はこの関数を呼び出すメインプログラムの例です。2021年2月から3月までの２か月間のデータを読み出しています。

Sub example2()
' 気象庁(JMA)の過去データからprec, blockで表される観測局の2021年2月～3月の10分毎降水量、気温、湿度、風速、日照時間を読み出す。

    Dim i As Integer
    For i = 2 To 3
      Call fetchJMA10min1month("81", "0778", 2021, i, True)
    Next i
End Sub

プログラムの実行方法

Excelで空白のブックを開き、①「開発」リボンで②「Visual Basic」を開きます。プロジェクトエクスプローラーで③「Microsoft Excel Oblects」を右ボタンクリックし、コンテクストメニューで④「挿入」－⑤「標準モジュール」を選びます。以上の操作で、⑥コードウインドウが開きます。

このコードウインドウに、前節までに示したコードをコピペしていきます。

コピペが終わったら、Visual Basicウインドウは閉じても構いません。ExcelファイルをExcel マクロ有効ブック(*.xlsm)形式で名前をつけて保存します。

次に、①「開発リボン」の②「マクロ」をクリックすると、example1とexample2が表示されていますので、③どちらかを選んで④「実行」をクリックしましょう。

マクロ実行前に選択していたセル（この例ではA1)を起点としてデータが読み込まれ、最終行の下のセルが選択された状態で停止するはずです。

これで大幅に省力化できるはずですよ。Have fun!