エクセル マクロの使い方について(webクエリ使用)

エクセルのマクロでweb上のデータを取り込みたいのですがループの方法がわかりません。
気象庁から、ある点(アメダス設置場所)の2009年1月1日～8月1日までの風速データを繰り返しとり、それをアメダスの設置分だけ同様に繰り返し抽出したいのですが素人のため変数の置き方がわかりません。

With ActiveSheet.QueryTables.Add(Connection:= _
URL;http://www.data…&block_no=0001&…&year=2009&month=1&day=1&elm=minutes&view="

これの
&block_no=0001&　(アメダス設置場所0002～1600くらいまで変化)と、
&year=2009&month=1&day=1&　(日にち)　の部分を変数にしたいです。

Dateなどを使えば下のループはできるのでしょうか？

ちなみに環境は windows XP(IE7) Excel2007です。

一応マクロの記録からループさせたいところをすべて載せておきます。
よろしくお願いします。


Sub Macro1()
'
' Macro1 Macro
'

'
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www.data.jma.go.jp/obd/stats/etrn/view/10 … _
, Destination:=Range("$A$1"))
.Name = _
"10min_a1.php?prec_no=11&prec_ch=%8F%40%92J%8Ex%92%A1&block_no=0001&block_ch=%8F%40%92J%96%A6&year=2009&month=1&day=1&elm=minutes&view="
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.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
Range("A2:C148").Select
Selection.Delete Shift:=xlToLeft
Range("B2:E148").Select
Selection.Delete Shift:=xlToLeft
ActiveWindow.SmallScroll Down:=135
Range("A149").Select

End Sub

No.8 ベストアンサー 回答者： _Kyle 回答日時： 2009/08/07 16:56

#4-5です。

【本題】SampleBにミスがありました。

外側ループの定数置き換えを忘れてますね。すみません。

×　For myBlk = 1 To 1601
　　↓
○　For myBlk = stBlk To edBlk

言わずもがなだろうとは思ったのですが、一応念のため(^^;;;

--------------

回答者サイドのやりとりに関して、
質問者さんに不快な思いをさせてしまい、申し訳ありません。お詫びします。

少なくとも私は、今回のご質問内容や質問者さんの対応について、
質問者さんの側に問題があったとはまったく考えておりませんし、
とりあえず（私の考える意味での）「解決」は得られたようですから、
その意味では非常に満足しています。

もっとも、#4-5のコードに関しては、
私自身の目から見てもいろいろと不手際がありまして、
正直【　どんだけ急いでたんだ＞私　orz　】な感じですが、
今更修正版をアップするのもアレなので、自重します(^^;;;

なお、技術的な問題が新たに判明すれば別ですが、
私としてはこれを最終回答にしますので、どうかご安心(?)ください(^^

以上ご参考まで。長乱文及びその他いろいろ陳謝。

この回答へのお礼

基本的にはsampleAを軸に今後の計算を行っていこうと思っていますので大丈夫です。
もらったものに少し手を加えて理想的なデータを得る状態にすることもできたので問題ないと思います。　

重ねてありがとうございました！

お礼日時：2009/08/07 23:45

No.7 回答者： Wendy02 回答日時： 2009/08/06 18:22

ご質問者様へ

こちらの聞いていることには答えられなかったようで、とても残念です。出来れば、事前に話をしていただいたほうが良かったです。基本的には、私は、お任せでは、VBAマクロは書かないことにしています。

ただ、一応、そのままにしておくことも可能ですが、常連としてては、ご質問者さんだけの問題でもないので、こちらの考えていたものをアップロードしておきます。偉そうなことを言いながら、この程度だと言われれば、それはそれで仕方がないです。こちらの考えていたものを、実際に作ってみた結果、目的のサイトが軽いせいなのか、QueryTable の誤動作もなく、IE Objectとの差がでなかったわけで、当初の目算が違ってしまいました。こちらの計測では、30日で、1分を割る程度のスピードです。

#4/5さんのお作りになったもので満足されているので、こちらのものは試す必要もありませんが、言ったからには、こういうものが作れるということだけぐらいの証拠程度にはなると思います。一応、いくつかの安全装置をつけました。最終的な仕上がりが見えているわけではありませんから、これで良いというわけではありません。シートを増やしたりするような配慮はしておりません。

現在のマクロでは、2～1600の地点の1/1から8/1までを取得しようとすれば、おそらく、メッセージが出てマクロは止まるはずです。メッセージが出なければ、そのまま行けるはずです。

標準モジュールに入れる限りは、どこにでも書き出しますから、アドインにして可能です。
なお、途中でやめたくなったら、Esc で、ループの中途解除ができます。修正しやすいように、「正規表現」を使いました。サイトの改編でも、ある程度は簡単に対応できます。正規表現などを含めて、多少の移植性は残しています。

なお、Vista + IE7 以上では、保護モードが働きますから、マクロでも解除は出来ますが、掲示板ではあまりお勧めできませんから、手動で外せば取得できます。

お分かりにはなっているとは思いますが、ULRのwww 以降は以下の通り
"data.jma.go.jp/obd/stats/etrn/view/10min_a1.php?prec_no=11&" & _

'-------------------------------------------
'標準モジュール
'-------------------------------------------
'Option Explicit
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Dim objReg As Object
Dim n As Integer
Dim k As Integer


Sub TestMacroIE()
　　'*Vista の場合は、IEの保護モードを解除してください
　　Dim StartDate As Date
　　Dim LastDate As Date
　　Dim ret As VbMsgBoxResult
　　Dim Dif As Integer
　　Dim fBNo As String 'ブロックNo 初期番号
　　Dim eBNo As String 'ブロックNo 最終番号
　　Dim BNo As String
　　Dim i As Long
　　Dim sURL As String
　　Dim sCol As String
　　Dim objIE As Object
　　Dim myContentHTML As String
　　Dim y As Long, m As Long, d As Long
　　Dim b As Integer 'ブロックNo のインクリメント
　　'-------------------------------------------
　　''ここはUserForm などで代入しても良い
　　StartDate = #1/1/2009# '最初の日 m/d/yyyy
　　LastDate = #8/1/2009# '最後の日 m/d/yyyy
　　
　　fBNo = 1 '*ブロックNo.
　　eBNo = 1 '*ブロックNo.
　　
　　''5:降水量,6:気温,7:風向,8:日照
　　k = 7
　　'-------------------------------------------
　　If fBNo > eBNo Then MsgBox "ブロック番号が逆です", vbExclamation: Exit Sub
　　If Val(eBNo) = 0 Then eBNo = fBNo
　　If Val(eBNo) = 0 And Val(fBNo) = 0 Then MsgBox "ブロック番号が空です。", vbExclamation: Exit Sub
　　
　　If Cells(1, Columns.Count).End(xlToLeft).Column - 1 > 0 Then
　　　　ret = MsgBox("データが既にありますが、続けますか？" & vbCrLf & _
　　　　"Y/追加　N/データ削除 Cancel/中止", vbInformation + vbYesNoCancel)
　　　　Select Case ret
　　　　　　Case vbYes: n = Cells(1, Columns.Count).End(xlToLeft).Column - 1
　　　　　　Case vbNo
　　　　　　　　n = 1
　　　　　　　　ActiveSheet.UsedRange.ClearContents
　　　　　　Case vbCancel: Exit Sub
　　　　End Select
　　End If
　　
　　Dif = LastDate - StartDate + 1
　　If Dif * (Val(eBNo) - Val(fBNo) + 1) + n > Columns.Count Then
　　　 MsgBox Dif * (Val(eBNo) - Val(fBNo) + 1) + n & "列：" & _
　　　 "シートの容量を超えます。", vbInformation
　　　 Exit Sub
　　End If
　　
　　Application.EnableCancelKey = xlErrorHandler
　　On Error GoTo ErrHandler
　　
　　Set objIE = CreateObject("InternetExplorer.Application")
　　Set objReg = CreateObject("VBScript.RegExp")
　　With objIE
　　　　
　　　　n = 1 '初期列(書き出し列)
　　　　For b = fBNo To eBNo
　　　　　　BNo = Format$(b, "0000")
　　　　　　For i = 0 To Dif - 1
　　　　　　　　y = Year(StartDate + i): m = Month(StartDate + i): d = Day(StartDate _
　　　　　　　　+ i)
　　　　　　　　sURL ="http://www.data.jma.go.jp/obd/stats/etrn/view/10 … & _
　　　　　　　　"block_no=" & BNo & "&year=" & y & "&month=" & m & "&day=" & d & _
　　　　　　　　"&elm=minutes&view="
　　　　　　　　
　　　　　　　　.Visible = False ' False　'慣れたらFalse にしてください。
　　　　　　　　.Navigate sURL
　　　　　　　　Do While .Busy
　　　　　　　　　　DoEvents
　　　　　　　　Loop
　　　　　　　　Do Until .ReadyState = 4
　　　　　　　　　　DoEvents
　　　　　　　　Loop
　　　　　　　　myContentHTML = .Document.Body.innerHTML
　　　　　　　　Sleep 500
　　　　　　　　AppActivate Application.Name
　　　　　　　　'リストを取る
　　　　　　　　PickUpDat myContentHTML
　　　　　　Next i
　　　　Next b
　　End With

ErrHandler:
　　objIE.Quit
　　Set objIE = Nothing
　　Set objReg = Nothing
　　Application.EnableCancelKey = xlInterrupt
　　If Err.Number = 18 Then
　　　　MsgBox "ユーザーによる割り込み中止をいたしました。", vbInformation
　　 ElseIf Err.Number > 0 Then
　　　　MsgBox Err.Number & ": " & Err.Description
　　Else
　　　　sCol = Cells(1, n - 1).Address(0, 0)
　　　　sCol = Left(sCol, Len(sCol) - 1)
　　　　MsgBox sCol & "列まで書き込みました。", vbInformation
　　End If
End Sub
Sub PickUpDat(strTxt As String)
　　Dim buf As String
　　Dim arTxt As Variant
　　Dim strTxt2 As String
　　Dim arBuf As Variant
　　Dim arList() As Variant
　　Dim i As Long
　　Dim j As Long
　　Dim iflg As Integer
　　Dim flg As Boolean
　　
　　j = 0
　　ReDim arList(2)
　　
　　'変更があって取れなくなったら、ContentHTMLから調べること
　　objReg.Pattern = "=.+=(.+日)"
　　objReg.Global = False
　　strTxt2 = Mid$(strTxt, InStr(strTxt, "<TABLE class=data2_s summary="))
　　If strTxt2 Like "*年*" Then
　　　　buf = objReg.Execute(strTxt2).Item(0).SubMatches(0)
　　End If
　　arList(0) = Mid(buf, 1, InStr(1, buf, Space(1), 1) - 1)
　　arList(1) = Mid(buf, InStr(1, buf, Space(1), 1) + 1)
　　
　　arTxt = Split(strTxt2, vbCr)
　　
　　objReg.Pattern = "\>([^\<]+)"
　　objReg.Global = False
　　strTxt2 = arTxt(k)
　　If strTxt2 Like "*/TH*" Then
　　　　buf = objReg.Execute(strTxt2).Item(0).SubMatches(0)
　　End If
　　
　　arList(2) = buf
　　
　　j = 2
　　'正規表現パターン
　　objReg.Pattern = "\>([^\<]+)" '"\>([\d+\.*\d*])"
　　objReg.Global = False
　　objReg.MultiLine = False
　　For i = LBound(arTxt) + 1 To UBound(arTxt)
　　　　If InStr(arTxt(i), "<TD style=""WHITE-SPACE:") > 0 Then
　　　　　　flg = True
　　　　ElseIf iflg = (k - 5) Then
　　　　　　j = j + 1
　　　　　　If arTxt(i) Like "*#*" Then
　　　　　　　　buf = objReg.Execute(arTxt(i)).Item(0).SubMatches(0)
　　　　　　End If
　　　　　　
　　　　　　ReDim Preserve arList(j)
　　　　　　arList(j) = buf
　　　　　　
　　　　　　flg = False: iflg = 0
　　　　ElseIf flg Then
　　　　　　iflg = iflg + 1
　　　　End If
　　Next i
　　Application.ScreenUpdating = False
　　If n <= Columns.Count Then
　　　　'書き出しの初期値
　　　　With Range("A1").Offset(, n - 1).Resize(UBound(arList()) + 1)
　　　　　　.NumberFormat = "0.0"
　　　　　　.Value = WorksheetFunction.Transpose(arList())
　　　　End With
　　Else
　　　　MsgBox "列数の限界を超えます", vbExclamation
　　　　End
　　End If
　　Application.ScreenUpdating = True
　　n = n + 1
End Sub

この回答へのお礼

僕の質問で変なやり取りをさせてしまって非常に申し訳ない気持ちでいっぱいです。

また回答のお礼が遅れてしまい＃３さんに対して失礼になってしまったことを深く反省しています。

今他のことに追われていて試せなかったのですが、これから試してみます。ありがとうございました。

＃４さんにも同様に感謝の気持ちが伝われば良いなと思っています。

重ねてありがとうございました。

お礼日時：2009/08/07 14:14

No.6 回答者： Wendy02 回答日時： 2009/08/05 19:15

#3の回答者です。

#4さんへ。

私の言葉で不快になられたのでしょうか？私の書き方が悪かったのでしょうか？別に、#4さんに向けたものでもないし、私は「上から目線」でアドバイスでもしたかのようなつもりではありません。それに、掲示板上で、玄人という立場で書いているわけでもありません。

別に、誰がコードを書こうが、最終的には、質問者さんの満足度ですから、その後で、自分ならこうだと披露するような、自己満足のコードはするつもりもありません。また、私は、挑発させられたとしても、それで奮起させられて、そのままコードを書くようなつもりもありません。ここのカテゴリは、回答をつけても完結せずに、そのままで終わることも多いので、どうしても、防衛的になります。あまりにも規模の大きすぎるものを、そのまま書くのは出来ないし、無駄なことはしたくないという主旨なのですが……。

ある程度の規模のものを作るなら、見込みで作るのではなく、作る前の確認作業、いわゆる「ヒアリング」が必要です。最終的に、完成に至らなくても、見通しを持ったコードは必要です。仕組みは単純ではあっても、そう簡単ではないと考えているからです。

#4さんのおっしゃっている中で、ご指摘の通りになっている通りです。

>2009年1月1日～8月1日までの風速データを繰り返しとり、

>&block_no=0001&　(アメダス設置場所0002～1600くらいまで変化)と、
>&year=2009&month=1&day=1&　(日にち)　の部分を変数にしたいです。

8/1- 1/1 + 1 = 213
1600 - 2 + 1 =1,599
144(1日) <10分ごとのデータ>
----------------
49,044,528
===========

4,900万セル

Excel 2007 は、1,048,576 行、

ですから、行で考えたら、とてもワン・シートでは納まりません、巨大なデータです。CSVで落とす方法もあるかもしれませんが、QueryTable は、途中で空回りしてくるという報告も聞いているのです。オブジェクトとしては、ひとつのWebサイトのデータを取得するためのものです。

このような規模のものになるものを、QueryTable を使って進めるのは、私は疑問を感じています。だから、出来上がりをどのように考えているのか、確認を取らないままには、そのまま進めるわけには行かないのではないでしょうか。

どういうふうするのか、より具体的な内容や設計が必要だということです。

それゆえに、私の持っている気がかりというものが、分かっていただけないのでしょうか。

No.5 回答者： _Kyle 回答日時： 2009/08/05 16:58

#4です。

URLをそのまま投稿するとマズいのは判ってたので
httpは分割していたのですが、WWWで引っ掛かりました(苦笑

そのままコピペすると動作しないと思いますので、
もし直し方が判らないようでしたら、後半部分を差し替えてください。

'--------------
Sub Sample1(ByVal myDte As Date, ByVal myBlk As String)
　Dim myUrl As String
　myUrl = Join(Array( _
　　"URL;h" & "ttp://w" & "ww.data.jma.go.jp/obd/stats/etrn/view/10min_a1.php?", _
　　"block_no=", myBlk, "&year=", Year(myDte), _
　　"&month=", Month(myDte), "&day=", Day(myDte), _
　　"&elm=minutes&view=p1"), "")
　With mySht.QueryTables("くえりて～ぶる")
　　.Connection = myUrl
　　.Refresh
　End With
End Sub
'--------------
Private Sub Sample0()
　Dim myUrl As String
　myUrl = _
　　"URL;h" & "ttp://w" & "ww.data.jma.go.jp/obd/stats/etrn/view/10min_a1.php?" & _
　　"block_no=0001&year=2009&month=1&day=1&elm=minutes&view=p1"
　With mySht.QueryTables.Add(Connection:=myUrl, Destination:=mySht.Range("A1"))
　　.Name = "くえりて～ぶる"
　　.FieldNames = True
　　.RowNumbers = False
　　.FillAdjacentFormulas = False
　　.PreserveFormatting = False
　　.RefreshOnFileOpen = False
　　.BackgroundQuery = False
　　.RefreshStyle = xlOverwriteCells
　　.SavePassword = False
　　.SaveData = False
　　.AdjustColumnWidth = False
　　.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
'==========================↑　ココマデ　↑==========================

この回答へのお礼

なんというか、ものすごい回答をありがとうございます。

丸投げしたということが非常に恥ずかしくなるような完璧な内容で恐縮です。


これでストップしていた研究も非常にはかどると思います。

本当にありがとうございました！

今度から投稿する時はもっと気をつけるようにします。

お礼日時：2009/08/05 19:02

No.4 回答者： _Kyle 回答日時： 2009/08/05 16:50

のっけから「余談」で恐縮ですが…。

こういう「原理的には単純」な課題でいそいそと作業するのは、
「いかにも素人っぽい反応」ですが、私は自他共に認める素人ですし、
丸投げ・作業依頼禁止の規約は何ヶ月も前に廃止されてるので
素人マクロを遠慮なく書かせていただきます(笑

なお、２～３日分試してみましたが
「これだけでは行かない」理由が判らなかったので、
ホントに何の工夫もない素人マクロです^^;;;

もちろん、私自身としては誠実に書いたつもりで、
「お茶を濁す」ようなつもりは毛頭ありませんが…。

もしかすると、
「上から目線でポイントだけアドバイス」したのに
うしろから素人コードをつけられてカチンときた玄人の方が
目から鱗が落ちるような素晴らしいコードを書いてくださるかもしれません。
--------------------------------
さて。

●所要時間について

日付：2009年1月1日～8月1日
場所：0002～1600（0001～1601？)
となると、30日×7ヶ月×1600地点でざっと３０万回以上読み込むことになりますよね。

ご承知のとおり、Webクエリは決して速い処理ではありません。
仮に毎秒1件処理したとしても、100時間ほどかかる計算ですが、
それは覚悟の上ということでしょうか？

まぁ、数日間PCを占有できれば、終わることは終わるので、
非現実的というほどではありませんが…。

ちなみに、既にご承知かと思いますが、
過去の10分値データであれば、CSV形式のものが
半年分数千円で手に入るようです。

■気象業務支援センター
http://www.jmbsc.or.jp/hp/offline/cd0300.html
----------------------------------
●サンプルコードについて

シートを作成するごとに自動で上書き保存するので、
あらかじめ名前をつけて保存したブックで起動してください。

下記コードのうち、

SampleAは、該当期間・全地点について繰り返しデータを読み込み、
【日付別にシートを作成】して地点・日付と平均風速のみを転記します。

SampleBは、該当期間・全地点について繰り返しデータを読み込み、
【地点別にシートを作成】して地点・日付と平均風速のみを転記します。

Sample0は、最左端のシートに雛形となるクエリテーブルを作成します。

Sample1は、日付と地点を指定すると、
URLを変更して、該当日、該当地点のデータを読み込みます。

なお、
シートを作成する際、既存シートの状況はチェックしていません。
中断後に再開する際は、
・最終日あるいは最終地点のシートを削除
・コードの開始日あるいは開始地点の設定を変更
してから起動してください。

また、
1日分全地点のデータが2MB、1地点全期間のデータが300KB
全体で400MBほどになりそうなので、
適当にブックを分けて作業した方が良さそうです。

以上ご参考まで。

'==========================↓　ココカラ　↓==========================
　Const stDte As Date = #1/1/2009#　'開始日
　Const edDte As Date = #8/1/2009#　'終了日
　Const stBlk As Long = 1　　　　　 '開始地点
　Const edBlk As Long = 1601　　　　'終了地点
　
　Dim mySht As Worksheet
'--------------
Sub SampleA()
　Dim myDte As Long
　Dim myBlk As Long
　Set mySht = Worksheets(1)
　Call Sample0
　For myDte = stDte To edDte
　　ThisWorkbook.Save
　　Worksheets.Add after:=Worksheets(Worksheets.Count)
　　ActiveSheet.Name = Format(myDte, "mm-dd")
　　For myBlk = stBlk To edBlk
　　　Call Sample1(myDte, Format(myBlk, "0000"))
　　　Cells(1, myBlk).Value = mySht.Cells(1, 1).Value
　　　Cells(2, myBlk).Resize(147).Value = mySht.Cells(2, 4).Resize(147).Value
　　　Application.StatusBar = _
　　　　CLng(myDte - stDte) & "/" & CLng(edDte - stDte + 1) & "(日)　： " & _
　　　　myBlk & "/" & edBlk - stBlk + 1 & "(地点)"
　　Next myBlk
　Next myDte
　Application.StatusBar = False
End Sub
'--------------
Sub SampleB()
　Dim myDte As Long
　Dim myBlk As Long
　Set mySht = Worksheets(1)
　Call Sample0
　For myBlk = 1 To 1601
　　ThisWorkbook.Save
　　Worksheets.Add after:=Worksheets(Worksheets.Count)
　　ActiveSheet.Name = Format(myBlk, "0000")
　　For myDte = stDte To edDte
　　　Call Sample1(myDte, Format(myBlk, "0000"))
　　　Cells(1, (myDte - stDte + 1)).Value = mySht.Cells(1, 1).Value
　　　Cells(2, (myDte - stDte + 1)).Resize(147).Value = mySht.Cells(2, 4).Resize(147).Value
　　　Application.StatusBar = _
　　　　CLng(myDte - stDte) & "/" & CLng(edDte - stDte + 1) & "(日)　： " & _
　　　　myBlk & "/" & edBlk - stBlk + 1 & "(地点)"
　　Next myDte
　Next myBlk
　Application.StatusBar = False
End Sub
'--------------
Sub Sample1(ByVal myDte As Date, ByVal myBlk As String)
　Dim myUrl As String
　myUrl = Join(Array( _
　　"URL;h" & "ttp://www.data.jma.go.jp/obd/stats/etrn/view/10min_a1.php?", _
　　"block_no=", myBlk, "&year=", Year(myDte), _
　　"&month=", Month(myDte), "&day=", Day(myDte), _
　　"&elm=minutes&view=p1"), "")
　With mySht.QueryTables("くえりて～ぶる")
　　.Connection = myUrl
　　.Refresh
　End With
End Sub
'--------------
Private Sub Sample0()
　Dim myUrl As String
　myUrl = _
　　"URL;h" & "ttp://www.data.jma.go.jp/obd/stats/etrn/view/10min_a1.php?" & _
　　"block_no=0001&year=2009&month=1&day=1&elm=minutes&view=p1"
　With mySht.QueryTables.Add(Connection:=myUrl, Destination:=mySht.Range("A1"))
　　.Name = "くえりて～ぶる"
　　.FieldNames = True
　　.RowNumbers = False
　　.FillAdjacentFormulas = False
　　.PreserveFormatting = False
　　.RefreshOnFileOpen = False
　　.BackgroundQuery = False
　　.RefreshStyle = xlOverwriteCells
　　.SavePassword = False
　　.SaveData = False
　　.AdjustColumnWidth = False
　　.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
'==========================↑　ココマデ　↑==========================

No.3 回答者： Wendy02 回答日時： 2009/08/05 10:16

こんにちは。

最初から、回答で拒否的な回答するのは、いかにも素人っぽい反応ですが、ある程度、経験のある方なら、それをどうすればよいのかは分かります。だから、逆に書けないのです。

QueryTable を使うにしろ、使わないにしろ、新たに作り直さなくてはならないということです。変数がどうとか、そういう範囲ではないと思います。

具体的な内容を言うと、
>2009年1月1日～8月1日までの風速データを繰り返しとり、それをアメダスの設置分だけ同様に繰り返し抽出したい

QueryTable は、基本的にその列全体を使用します。つまり追加が利きません。コード側の中のデータ取得が1日、10分ごとになっています。それを200回以上繰り返すことになります。Office 2007 なら入るとは思いますが、横に入れていくことになります。そのままでは、煩雑に、ただの生データです。結局は手作業と大差がありません。

たぶん、ご質問者さんは、

year=2009&month=1&day=1&elm=minutes&view="

ここを変数において、換えるようにすればよいと思っていらっしゃると思いますが、QueryTable 自体の問題なのです。単に、ループして、日付なりを変更しても、それだけでは意味がありません。データをストックし見やすいように並べなくてはなりません。

QueryTable を使用しなければ、また別の方法もありますが、私の個人的な事情で、ここ最近、マナーの悪い質問者が続いています。一旦作った内容を、リクエストで全面的に書き直させたり、せめて、正確なご質問内容があればと思って、お聞きしても答えないので、再度お聞きしたら、二回とも憤慨されたのか締めてしまった方もいます。それで、もう深追いしてお聞きする気になれません。私は、決して、掲示板で回答は書いても教えるのではなくて、全うなトレーニングですから、決して、丸投げが悪いとか、勉強していないから悪いわけではありません。ただ、回答したにも関わらず、不快な思いをさせられたくないだけです。

今回も、素人マクロでお茶を濁す程度なら可能ですが。

Dim Dif As Long
Dim mDate As Variant
Dim StartDate As Date
StartDate = DateValue("2009/1/1")

Dif = DateValue("2009/8/1") - StartDate + 1


For i = 0 To Dif
mDate = "year=" & Year(StartDate + i) & "month=" & Month(StartDate + i) & "&day=" & Day(StartDate + i) & "&elm=minutes&view="
'これを、ULR に入れてあげればよいわけです。

Next

ところが、これだけでは行かないのですが、2～3日の期間だけでも試してみれば分かります。

この回答へのお礼

回答と、いろいろなご指摘ありがとうございます。

はじめての言語で非常に戸惑っているのでもし質問内容が不快に感じたようでしたらお詫びもうしあげます。

クエリテーブルが列全体を使用するというのは余っている行でwebクエリを使用するのが不可能になるということでしょうか？

下記のように他のシートに情報(日付)を入れておいて変数に代入してやろうと試みていましたが変数の問題でないのならまた考え直さなければなりませんね。頑張ってみます！

ちなみに教えていただいたプログラムでは確かにうまくいきませんでした(ちゃんと狙い通りの動作をした上での失敗かはわかりませんが…)。

お礼日時：2009/08/05 15:41

No.2 回答者： fujillin 回答日時： 2009/08/05 10:15

ご提示のコードをループさせたいのでしたら、URLを引数にして受けるサブルーチンにしておいて、メインのルーチンからURLを組み替えて

　Macro1(URL)
みたいにして呼び出せばよいでしょう。

URLは文字列として扱えるので、変えたい部分を変更しながら都度ロケーションサーチの部分を組み替えてあげればよい。
　URL = url &文字列1 & 文字列2 & ・・・
みたいな感じで、変えたい部分を変数にしておいて、ループで入れ替えたものを合成してサーチ部を組み立てればよいでしょう。

サーチ部分の内容は調べているとは思いますが…
prec_no、block_no　が地域コードとブロックコードで、
prec_ch、block_ch　がその名前をエンコードしたもの。
year、month、day　が日付にあたる部分　などといった要領のようです。

さて、ご提示のサンプルをたどると「稚内」が表示されますが、サンプルののURLのblock_chを見てみると「宗谷岬」になっています。
また、サンプルでは稚内の（つもりなのか不明ですが）ブロックコードが0001になっていますが、気象庁のHPから追っていくと、稚内のブロックコードは47401になるはずです。
おまけにサンプルのURLの最後には不要なはずの「"」が付いています。

コーディングする上では↑のような不注意に、充分に気をつけられるのが宜しいかと思います。

この回答へのお礼

回答ありがとうございます。
昨日、日付の部分を他のシートの各セルに

year=2009&month=1&day=1
　　　　　：
year=2009&month=8&day=1

と書いておき、これを変数に代入し、URLに変数を置くことでできないかと思ってやってみましたが白紙ばかりがペーストされ、結局振り出しに戻っていたところでした。
サブルーチンとはC言語でいえば関数みたいなものですよね？がんばってみます。

ちなみにサーチ部分は調べたので確実だとは思いますが、
prec_ch、block_ch　は地域の名前をエンコードしたもので、0001～1600程度あります。

サイトで稚内をクリックすると確かに47401が最初に示されるのですが、それは気象台が設置されているところのコードで、他のアメダスと同様なコード(稚内なら0001)も同時に存在します。
ループにして回すならそちらの方が都合がいいので0001～という風にしました。

初の投稿でしたので、いろいろ不手際があったことをおわびします。

お礼日時：2009/08/05 15:14

No.1 回答者： samy88 回答日時： 2009/08/05 07:44

「素人のため変数の置き方がわかりません。

」「よろしくお願いします。」
皆素人から一生懸命勉強してできるようになっています。
マクロの記録だけを載せて、作成の丸投げに思えるのは自分だけでしょうか？
もう少し自分で考えてから投稿してはどうですか？
ネットでＥＸＣＥＬ ＶＢＡをちょっと検索すれば結構わかりやすく
説明しているサイトはたくさんありますよ。

この回答へのお礼

ご忠告ありがとうございます。
全くおっしゃる通りなのですが、現在研究を進める上でのひとつの情報処理作業ということであまり時間が与えられていない状態なのです。

時間が少なく、僕個人が言語系の操作の飲み込みに時間がかかってしまう方で藁にもすがるような気持ちでしたのでどうかご容赦ください。

お礼日時：2009/08/05 11:53