2009-10-19

気象庁からのデータを取得

毎日の気温データを1年分取得する

例題として気象庁 | 過去の気象データ検索から毎日の気温データを1年分取得する方法を考えてみます。
手順としては
  1. 一か月ごとのデータを手動で得る方法を調べる
  2. それをVBAで自動化する
  3. 得たデータをきちんと1年分揃える
となります。

一か月ごとのデータを得る

大量のデータを取得するにはプログラミングが必要ですが、そのためにはまず一カ月分だけでよいので手動でどうやって取得するのかを調べないとプログラムの書きようがありません。
気象庁 | 過去の気象データ検索を開きます。

場所を指定するために都府県支庁を選択をクリックします。

南極のペンギンに目が行きますが、今回は岡山をクリックします。

とりあえず2008年1月をクリックします。

月まで指定したことにより2008年1月の日ごとの値を表示 をクリックすることができるようになります。

このようにとりあえず一カ月分のデータは表示されますので、エクセルにコピーすることが出来ます。
このページのアドレス http://www.data.jma.go.jp/obd/stats/etrn/view/daily_s1.php?prec_no=66&prec_ch=%89%AA%8ER%8C%A7&block_no=47768&block_ch=%89%AA%8ER&year=2008&month=1&day=&elm=daily&view= をコピーしておきましょう。

エクセルによる取得

マウスでWebページを選択、コピーしてExcelに貼り付けるという操作は自動化し辛いので、Excel自身にWebページからデータを取得させましょう。
エクセルの「データ」タブをクリックして表示される「Webクエリ」をクリックします。

アドレス欄に先ほどコピーしておいたhttp://www.data.jma.go.jp/obd/stats/etrn/view/daily_s1.php?prec_no=66&prec_ch=%89%AA%8ER%8C%A7&block_no=47768&block_ch=%89%AA%8ER&year=2008&month=1&day=&elm=daily&view=を貼り付けて移動を押します。
すると先ほどと同じWebページが表示されるので、保存したいデータが書かれている表の左上の□にチェックをつけて「取り込み」をクリックします。

OKをクリックしたくなりますがその前にプロパティ(R)…をクリックします。

バックグラウンドで更新する(B)のチェックを外して、既存のセルを新規データで上書きし、使用されていないセルはクリアする(O)に●をつけてOKを押し、前の画面に戻ったらもう一度OKを押します。

するとこのようにエクセルのシートに表がコピーされます。

これでマウスを使ったコピー&ペーストを使わなくても、Excelのシートにデータを貼り付けることが出来るようになりました。

VBAによる取得

ここまでの処理をVBAを使って自動化したいので、前回紹介した「マクロの記録」を使って、先ほどの操作をVBAに記録しましょう。
最初からやり直しますので、先ほどコピーしたデータを一旦削除します。するとデータだけを消すか、Webページからデータを取得する方法も含めて消すかと尋ねられます。最初からやり直すために全部消したいからはい(Y)と答えます。

全部削除したら、前回の方法を使って先ほどの操作をVBAに記録します。すると次のようなプログラムになります。
Sub Macro1()
'
' Macro1 Macro
'
  With ActiveSheet.QueryTables.Add(Connection:= _
    "URL;http://www.data.jma.go.jp/obd/stats/etrn/view/daily_s1.php?prec_no=66&prec_ch=%89%AA%8ER%8C%A7&block_no=47768&block_ch=%89%AA%8ER&year=2008&month=1&day=&elm=daily&view=" _
    , Destination:=Range("$A$1"))
    .Name = _
    "daily_s1.php?prec_no=66&prec_ch=%89%AA%8ER%8C%A7&block_no=47768&block_ch=%89%AA%8ER&year=2008&month=1&day=&elm=daily&view=_1"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = False
    .RefreshStyle = xlOverwriteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlSpecifiedTables
    .WebFormatting = xlWebFormattingNone
    .WebTables = "3"
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False
  End With
End Sub
大事なのは"URL;http://www.data.jma.go.jp/obd/stats/etrn/view/daily_s1.php?prec_no=66&prec_ch=%89%AA%8ER%8C%A7&block_no=47768&block_ch=%89%AA%8ER&year=2008&month=1&day=&elm=daily&view="の部分です。このアドレスで表示されるページの中の.WebTables = "3"だから3番目の表をExcelにコピーするプログラムになっています。

注意

.Name = _
"daily_s1.php?prec_no=66&prec_ch=%89%AA%8ER%8C%A7&block_no=47768&block_ch=%89%AA%8ER&year=2008&month=1&day=&elm=daily&view=_1"
の部分にも"URL;http://…と同じようなことが書かれていますが、ここは単に名前ですので、データの取得には関係ありません。

アドレスの部分は「変数名=値」が&で区切られて続けられています。どの変数が何を示しているかは、値を変えながら色々試してみて推測するしかないのですが、2008年1月に関してはyear=2008とmonth=1に対応しているようです。従ってこの部分をプログラムで書き換えれば良さそうです。
試しに2008年2月のデータを取得してみましょう。
"URL;http://www.data.jma.go.jp/obd/stats/etrn/view/daily_s1.php?prec_no=66&prec_ch=%89%AA%8ER%8C%A7&block_no=47768&block_ch=%89%AA%8ER&year=2008&month=1&day=&elm=daily&view=" _
の部分を
    "URL;http://www.data.jma.go.jp/obd/stats/etrn/view/daily_s1.php?prec_no=66&prec_ch=%89%AA%8ER%8C%A7&block_no=47768&block_ch=%89%AA%8ER&year=2008&month=2&day=&elm=daily&view=" _
に書き換えて実行してみてください。
予想通り「岡山 2008年2月 (日ごとの値) 主な要素」が取得されましたが、29日以降に1月のデータが残ったままです。これでは困るので、全部削除する操作を調べて、Webから取得する直前に書きます。
全部削除する操作を調べるには、前回同様マクロの記録を使います。
Sub Macro2()
'
' Macro2 Macro
'
  Cells.Select
  Application.CutCopyMode = False
  Selection.QueryTable.Delete
  Selection.QueryTable.Delete
  Selection.ClearContents
End Sub
このように記録されましたが、試してみたところ
Cells.Select
Selection.QueryTable.Delete
Selection.ClearContents
だけで良さそうです。
但し、消すべきQueryTableがない場合に
Selection.QueryTable.Delete
を実行するとエラーになるので, (1,1)セルが空白でない場合だけ実行するように
Cells.Select
If Cells(1, 1) <> "" Then
  Selection.QueryTable.Delete
End If
Selection.ClearContents
とします。

この3行を
With ActiveSheet.QueryTables.Add(Connection:= _
の前に書き足して実行してみましょう。
Sub Macro1()
'
' Macro1 Macro
'
  Cells.Select
  If Cells(1, 1) <> "" Then
    Selection.QueryTable.Delete
  End If
  Selection.ClearContents

  With ActiveSheet.QueryTables.Add(Connection:= _
    "URL;http://www.data.jma.go.jp/obd/stats/etrn/view/daily_s1.php?prec_no=66&prec_ch=%89%AA%8ER%8C%A7&block_no=47768&block_ch=%89%AA%8ER&year=2008&month=2&day=&elm=daily&view=" _
    , Destination:=Range("$A$1"))
以下略

これでシートに書かれていた全てのデータとWebクエリを削除して、2008年2月のデータを貼り付けることが出来ました。

年月をプログラムで指定する

1月から12月まで取得するためには、月を示す変数mの値を1から12まで変化させて、上記プログラムを実行する必要があります。
しかし
Sub Macro1()
'
' Macro1 Macro
'
  Cells.Select
  Selection.QueryTable.Delete
  Selection.ClearContents

  m = 1
  With ActiveSheet.QueryTables.Add(Connection:= _
    "URL;http://www.data.jma.go.jp/obd/stats/etrn/view/daily_s1.php?prec_no=66&prec_ch=%89%AA%8ER%8C%A7&block_no=47768&block_ch=%89%AA%8ER&year=2008&month=m&day=&elm=daily&view=" _
    , Destination:=Range("$A$1"))
以下略
と書いたのでは、1月ではなくm月ということになってしまいます。mという文字ではなく変数mの値をURLとして使いたい場合は
    "URL;http://www.data.jma.go.jp/obd/stats/etrn/view/daily_s1.php?prec_no=66&prec_ch=%89%AA%8ER%8C%A7&block_no=47768&block_ch=%89%AA%8ER&year=2008&month=" & m & "&day=&elm=daily&view=" _
のように一旦文字列を"で切って、文字列を&で連結します。
本当は、文字列に変換する関数CStrを使って
    "URL;http://www.data.jma.go.jp/obd/stats/etrn/view/daily_s1.php?prec_no=66&prec_ch=%89%AA%8ER%8C%A7&block_no=47768&block_ch=%89%AA%8ER&year=2008&month=" & CStr(m) & "&day=&elm=daily&view=" _
と書くべきなのですが、CStrなしでも今回は動きました。

次の課題

この方法だと、1月のデータを貼り付ける→消す→2月のデータを貼り付ける→…の繰り返しになり、データを保存することができません。
そこで
1月のデータをsheet2に貼り付ける→必要な部分をsheet1に貼り付ける→sheet2を消す→2月のデータをsheet2に貼り付ける→必要な部分をsheet1に貼り付ける→sheet2を消す→…
のようなプログラムにします。Webクエリのような目新しさはなく地味な作業ですが、データ解析の下準備として重要です。
月によって何日まであるかが異なります。繰り返し回数が分からずFor文を使えない場合はDo While文を使います。
シートの選択はSheets(1).Select、1番目のシートの(2,3)セルはSheets(1).Cells(2,3)と書きます。

0 件のコメント: