• ベストアンサー
※ ChatGPTを利用し、要約された質問です（原文：あと少しなんですが、時系列の次のページに関して）

ダウンロードできない問題についての解決方法

このQ&Aのポイント
  • Yahoo時系列のページで、最初の50位まではダウンロードできるが、51位以降がダウンロードできない問題について解決方法を教えてください。
  • Scripte Eitorで確認したところ、ダウンロードURLが変化していることがわかりました。最初の50位まではURLが(1)の形式で、51位以降は(2)の形式になります。解決策を教えてください。
  • ExcelのVBAを使用してデータを取得していますが、51位以降のデータの取得方法が分かりません。どのように変更すればよいでしょうか？

質問者が選んだベストアンサー

  • ベストアンサー
  • redfox63
  • ベストアンサー率71% (1325/1856)
回答No.1

最後に『&x=.csv』が付くだけでなくパラメータyの値も変更する必要がありますよ 先頭からの場合 y=0 51番目以降の場合 y=50 101番目以降の場合 y=100 といった具合に変化するようです

t-tommy
質問者

お礼

ありがとうございます^^ 無事解決できました。

全文を見る
すると、全ての回答が全文表示されます。
  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. Visual Basic

関連するQ&A

  • 実行時エラー'1004': アプリケーション定義またはオブジェクト定義

    実行時エラー'1004': アプリケーション定義またはオブジェクト定義について Dim code As String Dim lastrow As Integer Dim i As Integer Sub calc() Dim code As String Dim day_s As Integer, month_s As Integer, year_s As Integer Dim day_e As Integer, month_e As Integer, year_e As Integer Dim row_length As Integer code = "998407.o" day_e = 31 month_e = 12 year_e = 2005 day_s = 1 month_ = 1 year_s = 2005 Range("B4:H65536").ClearContents For i = 0 To 365 * 0.65 Step 50 URL = "URL;http://table.yahoo.co.jp/t?s=" & code & "&a=" & month_s & "&b=" & day_s & "&c=" & year_s & "&d=" & month_e & "&e=" & day_e & "&f=" & year_e & "&g=d&q=t&y=" & i & "&z=" & code & "&x=.csv" If i = 0 Then lastrow = 4 Call GETデータ If Range("B4") = "" Then Exit Sub End If Else lastrow = Range("B4").End(xlDown).Row + 1 Call GETデータ Range("B" & lastrow, "H" & lastrow).Delete row_length = Range("B4").End(xlDown).Row If row_length - lastrow < 49 Then Exit For End If End If Next Range("B5:H65536").Sort key1:=Columns("B") lastrow = Range("B4").End(xlDown).Row Range("B5", "B" & lastrow).NumberFormatLocal = "yyyy/mm/dd" Range("A1").Select End Sub もうひとつ Sub GETデータ() With ActiveSheet.QueryTables.Add(Connection:=URL, Destination:=Cells(lastrow, 2)) ↑ここにデバックで黄色になります。 .Name = "t?s=998407.o&g=d" .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 = "10" .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False .Refresh BackgroundQuery:=False End With End　Subになります。Excel２００７です。

  • マクロ　VBA　簡単なことなのかもしれませんが？

    時系列をexcelにロードする際、http://table.yahoo.co.jp/t?c=2007&a=6&b=20&f=2007&d=9&e=21&g=d&s=1321.o&y=0&z=1321.o のページの　月日から月日までの部分と銘柄コード=excelシート入力済。⇒ＶＢＡ⇒ロードするための作業を、下記の方法で、とりあえず、終了日のところから改式をやってみたのですが、うまくゆきません。　"選択終了日"に変更する前の、数字の状態ではロードできるので、テーブル番号等は、問題ないようです。 原因の解る方、よろしくお願いします。 ----------------------------- Sub test() Range("a1:h300") = "" Dim shuuryoubi As String '選択終了日 Range("b1").Select With ActiveSheet.QueryTables.Add(Connection:= _ "URL;http://table.yahoo.co.jp/t?c=2007&a=6&b=20&f=2007&d=9&e=選択終了日&g=d&s=1321.o&y=0&z=1321.o" _ , Destination:=Range("b1")) .Name = _ "t?c=2007&a=6&b=20&f=2007&d=9&e=選択終了日&g=d&s=1321.o&y=0&z=1321.o" .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 = "23" .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False .Refresh BackgroundQuery:=False shuuryoubi = 17 End With End Sub

  • VBAでWebクエリにて情報を自動収集するプログラム

    自動売買ロボット作成マニュアルという本を買いました。 これは株などを自動売買するプログラムを作るための方法が書いた本です。（言語はエクセルに搭載されてあるVBAというプログラム言語です） そのプログラムを作る過程で、まずYahoo!ファイナンスから株価などの情報を10年分自動収集するプログラムを作ったのですが、「インターネットサーバーに接続できません」と出て、きちんと実行できません。 そこで、デバックをすると.Refresh BackgroundQuery:=Falseというプログラムのところがチェックされました。どうしたらいいでしょうか？ この文章だけでは対処できないと思いますのでプログラムを書いておきます。長々とお読みいただきありがとうございます。どうかお知恵をお貸しください。 Dim url As String Dim lastrow As Integer Dim i As Integer Sub Get_Data() With ActiveSheet.QueryTables.Add(Connection:=url, Destination:=Cells(lastrow, 2)) .Name = _ "t?s=998407.o&a=4&b=22&c=2008&d=7&e=24&f=2008&g=d&q=t&y=0&z=998407.o&x=_1" .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 = "19" .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False .Refresh BackgroundQuery:=False End With End Sub Sub Calc() Dim code As String Dim data_length As Integer, date_temp As Date Dim day_s As Integer, month_s As Integer, year_s As Integer Dim day_e As Integer, month_e As Integer, year_e As Integer Dim row_length As Integer code = "998407.o" data_length = -3650 date_temp = DateAdd("d", data_length, Now) day_e = Day(Now) month_e = Month(Now) year_e = Year(Now) day_s = Day(date_temp) month_s = Month(date_temp) year_s = Year(date_temp) Range("B4:H65000").ClearContents For i = 0 To Abs(data_length) * 0.65 Step 50 url = "URL; http://table.yahoo.co.jp/t?s=" & code & "&a=" & month_s & "&b=" & day_s & "&c=" & year_s & "&d=" & month_e & "&e=" & day_e & "&f=" & year_e & "&g=d&q=t&y=" & i & "&z=" & code & "&x=.csv" If i = 0 Then lastrow = "4" Call Get_Data If Range("B4") = "" Then Exit Sub End If Else lastrow = (Range("B4").End(xlDown).Row + 1) Call Get_Data Range("B" & lastrow, "H" & lastrow).Delete row_length = (Range("B4").End(xlDown).Row) If row_length - lastrow < 49 Then Exit For End If End If Next Range("B5:H65000").Sort Key1:=Columns("B") lastrow = Range("B4").End(xlDown).Row Range("B5", "B" & lastrow).NumberFormatLocal = "yyyy/mm/dd" Range("C5", "H" & lastrow).NumberFormatLocal = "0" Range("A1").Select End Sub

  • VBAでオーバーフローが出て困っています（エクセル2000です）

    自動売買ロボット作成マニュアルという本のなかに株価をダウンロードするためのプログラムとしてソースが書かれているのですが、オーバーフローとなってしまい、実行できません。lastrow = (Range("B4").End(xlDown).Row + 1)のところでオーバーフローを起こします。この文章だけでは対処できないと思いますのでプログラムを写します。 恐れ入りますが、お助けください。 Sub Calc() Dim code As String Dim data_length As Integer, date_temp As Date Dim day_s As Integer, month_s As Integer, year_s As Integer Dim day_e As Integer, month_e As Integer, year_e As Integer Dim row_length As Integer code = input_temp(2) data_length = -100 date_temp = DateAdd("d", data_length, Now) day_e = Day(Now) month_e = Month(Now) year_e = Year(Now) day_s = Day(date_temp) month_s = Month(date_temp) year_s = Year(date_temp) Range("B4:R65000").ClearContents For i = 0 To Abs(data_length) * 0.65 Step 50 If i = 0 Then lastrow = "4" For wtbl = 19 To 25 url = "URL;http://table.yahoo.co.jp/t?s=" & code & "&a=" & month_s & "&b=" & day_s & "&c=" & year_s & "&d=" & month_e & "&e=" & day_e & "&f=" & year_e & "&g=d&q=t&y=" & i & "&z=" & code & "&x=.csv" Call Get_Data If Range("B4") = "日付" Then Exit For Else Range("B4:H54").ClearContents End If Next Else url = "URL;http://table.yahoo.co.jp/t?s=" & code & "&a=" & month_s & "&b=" & day_s & "&c=" & year_s & "&d=" & month_e & "&e=" & day_e & "&f=" & year_e & "&g=d&q=t&y=" & i & "&z=" & code & "&x=.csv" lastrow = (Range("B4").End(xlDown).Row + 1) Call Get_Data Range("B" & lastrow, "H" & lastrow).Delete row_length = (Range("B4").End(xlDown).Row) If row_length - lastrow < 49 Then Exit For End If End If Next Range("B5:H65000").Sort Key1:=Range("B5") lastrow = Range("B4").End(xlDown).Row Range("B5", "B" & lastrow).NumberFormatLocal = "yyyy/mm/dd" Range("C5", "H" & lastrow).NumberFormatLocal = "0" Range("A1").Select End Sub Sub Get_Data() With ActiveSheet.QueryTables.Add(Connection:=url, Destination:=Cells(lastrow, 2)) .Name = "Yahoo" .FieldNames = False .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = False .RefreshPeriod = 0 .WebSelectionType = xlSpecifiedTables .WebFormatting = xlWebFormattingNone .WebTables = wtbl .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .Refresh BackgroundQuery:=False End With End Sub

  • 「Excel VBA」 Webクエリ マクロ「実行時エラー"1004"ファイルにアクセスできませんでした」

    Webクエリを使って、「Yahooファイナンス」から日経平均株価の時系列データを取得したいのですが、うまくいきません。(TT) 下記に全コードを記載しますので、ご回答よろしくお願いします。 Dim url As String Dim lastrow As Integer Dim i As Integer Sub Calc() '価格データを取得するマクロ 'このマクロ内で用いる各変数を宣言 Dim code As String Dim day_s As Integer, month_s As Integer, year_s As Integer Dim day_e As Integer, month_e As Integer, year_e As Integer Dim row_length As Integer '変数に各値を代入 code = "998407.o" '株価コード day_e = 31 '取得終了日 month_e = 12 '取得終了月 year_e = 2005 '取得終了年 day_s = 1 '取得開始日 month_s = 1 '取得開始月 year_s = 2005 '取得開始年 '価格データを取得 For i = 0 To 365 * 0.65 Step 50 '変数にURLを代入 url = "URL;http://table.yahoo.co.jp/t?s=" & code & "&a=" & month_s & "&b=" & day_s & "&c=" & year_s & "&d=" & month_e & "&e=" & day_e & "&f=" & year_e & "&g=d&q=t&y=" & i & "&z=" & code & "&x=.csv" '1回目の繰り返しの場合 If i = 0 Then lastrow = "4" Call Get_Data '価格データが取得できなかった場合、マクロを終了させる 　　　　If Range("B4") = "" Then Exit Sub End If '2回目以降の繰り返しの場合 Else lastrow = Range("B4").End(xlDown).Row + 1 Call Get_Data '見出しのセルを削除 Range("B" & lastrow, "H" & lastrow).Delete row_length = Range("B4").End(xlDown).Row '価格データが取得期間分存在していなかった場合、その時点で繰り返しを終了させる If row_length - lastrow < 49 Then Exit For End If End If Next End Sub Sub Get_Data() With ActiveSheet.QueryTables.Add(Connection:=url, Destination:=Cells(lastrow, 2)) .Name = "t?s=998407.o&g=d" .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 = "22" .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False .Refresh BackgroundQuery:=False End With Range("B5:F54").Select Selection.Sort Key1:=Range("B5"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _ :=xlPinYin, DataOption1:=xlSortNormal End Sub Calcマクロを実行すると、　 「実行時エラー"1004"ファイルにアクセスできませんでした。次のいずれかを行ってください。」　というエラーが出て止まってしまいます。 デバッグをすると、「Get_Dataマクロ」内の、 .Refresh BackgroundQuery:=False　が黄色になります。 ステップインしても、やっぱり、 .Refresh BackgroundQuery:=False　の所でエラーが出ます。(TT) どうしても解決したい内容なので、 少しでも「解決の可能性」があれば、なんでも試してみたいと思っていますので、どうぞお気軽に回答お願いします。 力を貸しください。よろしくお願いします。

  • データのある所まで指定したい(2)　　文字検索の追加

    E列に結果を表示させますが、それぞれの結果のEセル（左上）に「問題」という文字があればそのまま実行し、 なければ元アドレスであるB列でMsgBox（k &　”行目は間違っています”）と表示させたい。 お願い致します。 Dim y(80) As String Dim cp(80) As String Dim i As Integer e = 70 For i = 3 To Range("B65536").End(xlUp).Row y(i) = Range("B" & i).Value cp(i) = Range("P" & i).Value With ActiveSheet.QueryTables.Add(Connection:= _ "URL;" & y(i), Destination:=Range("E" & e + 1)) .Name = "000" .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 = "" & cp(i) .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False .Refresh BackgroundQuery:=False End With e = Range("E65536").End(xlUp).Row Next i

  • データのある所まで指定したい

    下記のようにB3からB80までマクロ実行できる様に設定しておきます。 例えばB38までしかデータがない場合、B39でデバッグになってしまいます。 データの入っている所まで実行できるようにお願い致します。 e = 70 ***************************************************** Dim y3 As String y3 = Range("B3").Value Dim cp3 As String cp3 = Range("P3").Value With ActiveSheet.QueryTables.Add(Connection:= _ "URL;" & y3, Destination:=Range("E" & e + 1)) .Name = "000" .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 = "" & cp3 .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False .Refresh BackgroundQuery:=False End With e = Range("E65536").End(xlUp).Row ****************************************************** 　　　　　・ 　　　　　・ 　　　　　・ ****************************************************** Dim y80 As String y80 = Range("B80").Value Dim cp80 As String cp80 = Range("P80").Value With ActiveSheet.QueryTables.Add(Connection:= _ "URL;" & y80, Destination:=Range("E" & e + 1)) .Name = "000" .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 = "" & cp80 .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False .Refresh BackgroundQuery:=False End With e = Range("E65536").End(xlUp).Row ********************************************************

  • シートにあるキーワードを別のシートで検索し、該当する行（複数行）を新ブックに貼り付けたい

    今週から勉強を始めたくらいのマクロ初心者なので言っている事が分かりにくかったらすみません。 エクセルVBAでマクロを組んでいるのですが、 Sheet1にあるキーワード（B3～）をSheet2の指定の列で検索し、 そのキーワードが含まれている行を新しいブックにコピーするものを作成したいです。 どうやっても検索とシートのコピーのところがうまくいかず、Sheet2の行数が2万ぐらいあるのでどの方法で検索をしたらいいのか困っています。 とりあえずブック内にシートを1つ作って、そこにヒットした行を貼り付け新しいブックにコピーすればいいのかと思いやっているのですが、動きません… 以下に現時点でのソースを記載するのでどこがまずいのか助言宜しくお願いします。 Sub kensaku() Dim key As String Dim target As String Dim x As Integer Dim y As Long Dim z As Long x = 3 y = 10 z = 1 Set sh = Worksheets.Add sh.Name = "kekka" key = Worksheets("Sheet1").Range("B" & x).Value Do Until Worksheets("Sheet1").Range("B" & x) = "" target = Worksheets("Sheet2").Range("F" & y).Value Do Until Worksheets("Sheet2").Range("F" & y) = "" If target = key Then Worksheets("Sheet2").Rows(y).Select Selection.Copy Sheets("kekka").Rows(z).Activate Activesheet.Paste z = z + 1 End If y = y + 1 Loop x = x + 1 Loop Worksheets("kekka").Copy Application.DisplayAlerts = False Worksheets("kekka").Delete Application.DisplayAlerts = True End Sub

  • 配列表示と間引き

    配列の間引きをを教えて下さい。 下記文を書きました Sub 配列() Dim u As Integer '左 Dim v As Integer '中 Dim w As Integer '右 Dim x As Integer '左 Dim y As Integer '中 Dim z As Integer '右 Dim row As Integer '行カウンタ Dim col As Integer '列カウンタ Dim intSheet As Integer 'シートカウンタ Dim blnNextPage As Boolean '次シートフラグ '初期値セット u = 1 v = 2 w = 3 x = 4 y = 5 z = 5 row = 0 col = 1 intSheet = 1 Do While (1) 'zカウント z = z + 1 If z > 20 Then 'zが20以上ならy+1 y = y + 1 If y > 19 Then 'yが20以上ならx+1 x = x + 1 If x > 18 Then 'xが20以上ならy+1 w = w + 1 If w > 17 Then 'wが20以上ならx+1 v = v + 1 If v > 16 Then 'wが20以上ならx+1 u = u + 1 '終了条件 If (x = 19 And y = 19 And z = 20) Then Exit Do 'v初期化 = x+1 v = u + 1 End If 'w初期化 = y+1 w = v + 1 End If 'x初期化 = x+1 x = w + 1 End If 'y初期化 = y+1 y = x + 1 End If 'z初期化 = y+1 z = y + 1 End If If z > 20 Then Exit Sub '行カウント row = row + 1 If row > 1000 Then '1000で次の列か次のページへ If blnNextPage Then '行・列カウンタ初期化 col = 1 row = 1 '次のシートへ intSheet = intSheet + 1 '次のシートが無い場合は追加 If intSheet > Worksheets.Count Then Sheets.Add After:=Worksheets(Worksheets.Count) End If 'シートをアクティブに Worksheets(intSheet).Select 'フラグ消去 blnNextPage = False Else '次の列へ col = col + 6 row = 1 'blnNextPage = True End If End If If col = 6 * 3 + 1 Then blnNextPage = True End If 'データ表示 Worksheets(intSheet).Range(Chr(64 + col) & row).Cells = u Worksheets(intSheet).Range(Chr(64 + col + 1) & row).Cells = v Worksheets(intSheet).Range(Chr(64 + col + 2) & row).Cells = w Worksheets(intSheet).Range(Chr(64 + col + 3) & row).Cells = x Worksheets(intSheet).Range(Chr(64 + col + 4) & row).Cells = y Worksheets(intSheet).Range(Chr(64 + col + 5) & row).Cells = z Loop End Sub 上記文で表示をしますが、 ６列目までの間に３列の連数字の時には表示を行わず、次に移る様にしたいのですが、どうすれば良いでしょうか？ 1,2,5,6,10,12はOKです 1,2,3,5,6,10又は1,3,4,5,10,11等３連の数字は表示を行わない。

  • チェックボタンでチェックした値をセルに連続入力

    チェックボタンでチェックした行(表-1)を下記のコードでExcelセル(表-2)に入力できたのですが既にに"B2:E3","B10:E10",に値が入力されている場合、B4から続けて入力したいのですがどのように コードを追記すれば良いのかどなたかわかる方よろしくお願いします。 Sub 入力() Dim i As Integer Dim j As Integer Dim k As Integer k = 3 i = Range("Z65536").End(xlUp).Row For j = 3 To i If Range("Z" & j).Value = True Then k = k + 1 Range("B" & k).Value = k - 1 Range("H" & j, "K" & j).Copy Range("B" & k) End If Next j End Sub

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する