[[20150407195157]]　『VBAでのデータ収集』（kanappe）　ページの最後に飛ぶ

『VBAでのデータ収集』（kanappe）

気象庁のページから毎日の天候データを取ってきて何年間かのものを時系列順に並べたいのですがうまくプログラムが書けません。
本を参考に悪戦苦闘していますが、月によって日数が異なることとデータを書き出すところがよくわかりません。
http://www.data.jma.go.jp/obd/stats/etrn/view/daily_s1.php?prec_no=44&block_no=47662&year=2014&month=1&day=1&view=
このurlの年と月を変える方法で下のプログラムを書こうと試みています。
よろしくお願いします。

Sub 気温取得()

  Dim url As String
  Dim year As Integer
  Dim month As Integer
  Dim dst As Range
  Dim i As Long

            year = 2000

            month = 1
            Do While year < 13
            month = month + 1
             url = "URL;http://www.data.jma.go.jp/obd/stats/etrn/view/10min_s1.php?prec_no=44&block_no=47662&year=" & year.Value & "&month=" & month.Value & "&day=1&view="
              '気温の表へデータ転記
             Set dst = Worksheets("気温").Cells(Cells.Rows.Count, 1).End(xlUp).Offset(1, 0)
             If month.Value="1"Or month.Value="3"Or month.Value="5"Or month.Value="7"Or month.Value="8"Or month.Value="10"Or month.Value="12"
             Then i=31
             Else: month.Value = "4" Or "6" Or "9" Or "11"
             Then i=30
             Else: i = 29

             dst.Offset(i, 0).Value = Date
            Do While year < 2015
            year = year + 1

    With ActiveSheet.QueryTables.Add(url, Range("A3"))
      .WebTables = "2"
      .WebSelectionType = xlSpecifiedTables
      .Refresh False
    End With
  Next
End Sub

＜使用 Excel：Excel2013、使用 OS：Windows8 ＞

 こまごましたミスがたくさんなので、違いを確認してみてください。

 Option Explicit

 Sub 気温取得()
    Dim url As String
    Dim year As Long
    Dim month As Long
    Dim dst As Range

    Application.ScreenUpdating = False

    For year = 2010 To 2014
        For month = 1 To 12
            Set dst = Worksheets("気温").Cells(Cells.Rows.Count, 1).End(xlUp).Offset(2, 0)
            dst.Value = DateSerial(year, month, 1)
            dst.NumberFormatLocal = "YYYY/MM"
            url = "URL;http://www.data.jma.go.jp/obd/stats/etrn/view/daily_s1.php?prec_no=44&block_no=47662&year=" & year & "&month=" & Format(month, "00") & "&day=1&view="

            With ActiveSheet.QueryTables.Add(Connection:=url, Destination:=dst.Offset(1))
                .PreserveFormatting = True
                .WebSelectionType = xlSpecifiedTables
                .WebTables = """tablefix1"""
                .Refresh BackgroundQuery:=False
            End With
        Next
    Next
    Application.ScreenUpdating = True
 End Sub

（Mook） 2015/04/07(火) 21:12

 追伸

 Option Explicit を使えば、原因の８割はVBE が教えてくれたと思います。
 ぜひご利用ください。

（Mook） 2015/04/07(火) 21:28

ありがとうございます。ひと通りデータが採取出来ました。

ですが、月ごとにとったデータとデータの間にヘッダ（気温、気圧などの文字）や空欄になっている行がありデータ分析にすぐに使えない状態です。
これらを消すにはデータ収集前のプログラムの中に消してつなげるプログラムを書き加えるのか、それとも一度データ採取し終わった後に消すプログラムを書いたほうが良いのか教えて下さい。（個人的には前者の方法を知り今後に活かしていきたいです。）
よろしくお願いします。
（kanappe） 2015/04/10(金) 20:06

 WebQuery ではテーブルの部分読み込みは出来ませんので、読み込み後に削除してください。

 テーブル間の日付や空白が不要であれば、
 .End(xlUp).Offset(2, 0)
 は
 .End(xlUp).Offset(1)

 dst.Value = DateSerial(year, month, 1)
 は削除

 Destination:=dst.Offset(1))
 は
 Destination:=dst)

 EndWith の後ろに、
 dst.Resize(3, 1).EntireRow.Delete
 を追加で。

（Mook） 2015/04/10(金) 21:14

dst.Resize(4, 1).EntireRow.Deleteとしたら完璧に出来ました。
ありがとうございました。
（kanappe） 2015/04/11(土) 17:23

コメント返信：

[ 一覧(最新更新順) ]

[[20150407195157]] 『VBAでのデータ収集』（kanappe） ページの最後に飛ぶ

[[20150407195157]]　『VBAでのデータ収集』（kanappe）　ページの最後に飛ぶ