質問: 時系列データーの取得方法を教えてください。
回答: このvbaがどこにあるか(どこかのシートのモジュール部なのか標準モジュール部なのか)わからないのですが、標準モジュール部にあるなら >Sheets.Add をした後に >With ActiveSheet.QueryTables.Add(Connection:= _ "URL;" & Cells(df, 1) & "-" & Cells(df, 3) & "", Destination:=Range("A1") _ ) >.Name = "jikeiretsu.aspx?c=" & Cells(df, 1) & "-" & Cells(df, 3) & "" をすると Cells(df, 1) & "-" & Cells(df, 3) の部分は追加したシートのセルの値(当然空白)を持ってくると思います。 前後や画像(?)がわからないので、銘柄コード(6752)や市場コード(T)があるシートがわからないのですが、例えばsheet1にある場合は With ActiveSheet.QueryTables.Add(Connection:="URL;" & Sheets("Sheet1").Cells(df, 1) & "-" & Sheets("Sheet1").Cells(df, 3) & "", Destination:=Range("A1")) .Name = "jikeiretsu.aspx?c=" & Sheets("Sheet1").Cells(df, 1) & "-" & Sheets("Sheet1").Cells(df, 3) とすればどうでしょうか? ちなみに Destination:=Range("A1") の部分は.addしたシートのA1なのでそのままでいいと思います。 【 補足への回答 】 こんな感じでしょうか? 最後の終値をSheet1のD列へ取得します。 Sub sample() Dim qt As QueryTable Dim r As Long Sheets("Sheet2").Cells.Clear 'Sheet2クリア Set qt = Sheets("Sheet2").QueryTables.Add(Connection:="URL;", Destination:=Sheets("Sheet2").Range("A1")) 'Sheet2にクエリテーブル追加 qt.WebSelectionType = xlAllTables '全テーブル読み込み(と言ってもこのページには1個しかないので) qt.WebFormatting = xlWebFormattingNone '値のみ取得(別にxlWebFormattingAllでもいいけれど) r = 2 'Sheet1での注目行の初期値 Do While Sheets("Sheet1").Range("A" & r) <> "" 'Sheet1の注目行のA列の値が空白でなければ(A列にデータがあれば) qt.Connection = "URL;" & Sheets("Sheet1").Range("A" & r) & "-" & Sheets("Sheet1").Range("C" & r) 'URL設定 qt.Refresh BackgroundQuery:=False '更新(更新終了まで待つ) Sheets("Sheet1").Range("D" & r) = Sheets("Sheet2").Range("E3") '最後の終値をSheet1のD列へ r = r + 1 Loop End Sub 標準モジュールではシート指定の無いRange(またはCells)ではシートはActiveSheetになるようです。 それを利用してSheet指定を減らすためにSelectした場合です。 Sub sample() Dim qt As QueryTable Dim r As Long Sheets("Sheet2").Select 'Sheet2選択 Cells.Clear 'Sheet2クリア Set qt = ActiveSheet.QueryTables.Add(Connection:="URL;", Destination:=Range("A1")) 'ActiveSheet(Sheet2)にクエリテーブル追加 qt.WebSelectionType = xlAllTables '全テーブル読み込み(と言ってもこのページには1個しかないので) qt.WebFormatting = xlWebFormattingNone '値のみ取得(別にxlWebFormattingAllでもいいけれど) Sheets("Sheet1").Select 'Sheet1選択 r = 2 'Sheet1での注目行の初期値 Do While Range("A" & r) <> "" 'Sheet1の注目行のA列の値が空白でなければ(A列にデータがあれば) qt.Connection = "URL;" & Range("A" & r) & "-" & Range("C" & r) 'URL設定 qt.Refresh BackgroundQuery:=False '更新(更新終了まで待つ) Range("D" & r) = Sheets("Sheet2").Range("E3") '最後の終値をSheet1のD列へ r = r + 1 Loop End Sub