毎日の気温データを1年分取得する
気象庁 | 過去の気象データ検索から毎日の気温データを1年分取得する方法を考えてみます。手順としては
- 一か月ごとのデータを手動で得る方法を調べる
- それをVBAで自動化する
- 得たデータをきちんと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文を使います。
この方法ではこのように一か月分のデータが取得しされます。
何カ月分ものデータをこのように整理して保存しましょう。
1月のすぐ下に2月のデータが来るようにします。すると日付も、年月がないとわけが分からなくなります。さらに通し番号で整理したいので「年」「月」「日」を一つにまとめた列も作ります。
今回は地味で細かな作業の繰り返しになりますので色をつけて説明します。
プログラム全体の構成としては
For m = 1 to 12
2008年m月のデータをSheet2に取得
If m = 1 then
上部の項目名をSheet1へコピー
End If
m月のデータをSheet1へコピー
Next m
となります。
WebからSheet2へデータを取得して、それをSheet1に整理することにしましょう。
まず最初に、データの項目の説明が必要ですので、Sheet2の黄色い部分、つまり2行目から5行目、B列からU列(2列から21列)を、
Sheet1の1行目から4行目、E列目からX列目(5列目から24列目)へコピーします。
次に、毎月、日にちとデータの部分、つまりSheet2のオレンジ色の部分、の6行目からデータの最後の行まで、A列目からU列目(1列から21列)を、
Sheet1の前月のデータの次の行以降、D列目からX列目(4列目から24列目)へコピーします。
それと同時に、Sheet1のA1セルに書かれた年と月を、Sheet1に先ほど貼り付けたデータの2列目と3列目へコピーします。
最後に、日付の通し番号として、Sheet1のB,C,D列を/で繋げてA列に書きます。
シートの選択とシートを指定してのCells
Webクエリによる取得は、選択しているシートに貼り付けられますので、Webクエリを実行しておく前にデータを貼り付けたいシートを手前に出しておきます。そのためには、Sheets(1).Selectのように、括弧の中に何番目のシートなのか番号を書いて指定します。あるいはSheets("Sheet1").Selectのようにシートの名前を指定することもできます。
また、シートの間を跨いでのコピーは、例えば今回のようにシート2のB2セルをシート1のE1へコピーするなら
Sheets(1).Cells(1, 5) = Sheets(2).Cells(2, 2)
と書きます。
このように複数のシートに跨るプログラムは、必ず標準モジュールに書いてください。
標準モジュールがない場合は挿入(I)標準モジュール(M)をクリックして追加してください。
データの数を数える
Webから取得したデータの個数は、その月の日数により変化します。これが分からないと、シート2から何行をシート1にコピーするか、そしてシート1の何行目までデータが入っているか分からないので調べる必要があります。今回のデータは日数なので日付A列の最大値がデータの個数ですが、一般にはこのような通し番号が付いていないこともあるので、データを上から見ていって、無くなるまで数えます。そのためにはWhile文を使います。While文の書式は
Do While 条件
文1
文2
…
Loop
です。条件が成立している間、Do WhileとLoopで挟まれた文を実行します。
シート2のデータであればCells(6, 1)から順にCells(7, 1), Cells(8, 1),…と見ていって、データが無くなるまで続けます。
但し、(6, 1)から始まるのは紛らわしいので、まず
Cells(6, 1).Select
を実行してCells(6, 1)を選択しておくと
Selection.Cells(1, 1)がCells(6, 1)
Selection.Cells(2, 1)がCells(7, 1)
…
ということになってi番目のデータがSelection.Cells(i, 1)となって分かりやすいです。
以上をまとめて
j = 1 '←jを他のループで使っている場合は別の変数を使ってください。
Cells(6, 1).Select
Do While Selection.Cells(j, 1) <> "" '←<>は大きいか小さい、つまり等しくないことを表し、""は何もないことを表します。つまり<> ""は「空白ではない」という意味です。
j = j + 1
Loop
によって、データの個数を数えることが出来そうです。本当に数えることが出来たか確かめるために、このプログラムの次の行に
MsgBox (j)
と書いて実行してみてください。31と表示されましたか？違っていたら原因と対策を考えてください。
他にも
Do Until 条件
文
Loop
とか
Do
文
Loop While 条件
とか
Do
文
Loop Until 条件
があります。条件が文より下にあると、少なくとも一度は実行されます。文を実行しないと条件がチェックできない場合に使います。
データのコピー先
シート2のデータをシート1にコピーする場合、コピー元は毎月6行目からなのでCells(1,1)から順にコピーすれば良いのですが、 コピー先は最初の4行が項目名なので1月は5行目から、2月は5+31=36行目から…となるので位置が変動します。従って、データが既に何行目まで記録されているかを示す変数(例えばlastのような名前)を使って、次のデータをどこにコピーすれば良いのかを管理しておきます。
例えば1月分のデータをコピーする場合は
このようになっているので5行目から、
2月分の場合は
36行目からですが、この何行目、というのを目で見て数えるのではなく、変数に記録しておくということです。
課題
第一問:このような形で1年分のデータを収集するプログラムを書いてください。第4行の「日付」とか「年」はコピーするのではなくて
Cells(4, 1) = "日付"
Cells(4, 2) = "年"
のように""で囲った文字列を代入します。A列の日付はB,C,D列を繋げますので
Cells(j, 1) = Cells(j, 2) & "/" & Cells(j, 3) & "/" & Cells(j, 4)
と書けばよいでしょう。
B列, C列の年月はSheets(2)の(1,1)セルから切り出すなら
Mid(Sheets(2).Cells(1, 1), 5, 4)
Mid(Sheets(2).Cells(1, 1), 10, 2)
のようにMid関数を使って、何文字目から何文字、という取り出し方でもいいですが、単純にWebから取得するときに指定した年, 月を表す変数の値を書いて構いません。
第二問:2007年1月から2008年12月までの2年分のデータを収集するプログラムを書いてください。これが出来ればどんなに長い期間のデータでも同様に収集できます。
0 件のコメント:
コメントを投稿