VBA Webクエリの実行とデータ取得方法

このQ&Aのポイント
  • VBAを使ってWEBクエリを実行し、取得したデータを連続してシートに入力する方法について質問します。
  • 質問者はVBA初心者であり、見よう見真似で作成したVBAコードがうまく動かない状況です。
  • WEBクエリの実行により取得したデータが一部消えてしまい、連続してクエリを実行できない問題が発生しています。添削方法を教えていただきたいとのことです。
回答を見る
  • ベストアンサー

VBA Webクエリについて

VBA初心者です。 VBAを使い、下記「やりたいこと」をしたいのですが、 「質問内容」にありますように、上手くできません…。 基礎がわかっていない為、お粗末な内容かもしれませんが、 教えてください。何卒よろしくお願い致します。 ■やりたいこと シート「1」にあるURLアドレスのリスト(C列)に沿って WEBクエリを実行し、シート「2」に取得したデータを 連続して末行に入力したいです。 ■質問内容 見よう見真似で、下記VBAを作成しました。(1To3は仮の回数です) WEBクエリが実行され、末行に取得データが入力されますが、 1回目、2回目の取得データは消え(長い空白行ができ)、 ラストの3回目のデータのみが残るかたちになります。 取得したデータが消えず、連続してWEBクエリを実行できるよう 下記を添削して頂けませんでしょうか。 ---------------------------------------------------------------- Sub Macro2() Dim Lrow As Long For カウンタ = 1 To 3 Lrow = Worksheets("2").Range("A" & CStr(Rows.Count)).End(xlUp).Row セル範囲 = "C" & カウンタ With ActiveSheet.QueryTables.Add(Connection:= _ "URL;" & Worksheets("1").Range(セル範囲).Value, Destination:=Worksheets("2").Range("A" & Lrow)) .Name = Worksheets("1").Range(セル範囲).Value .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .WebSelectionType = xlEntirePage .WebFormatting = xlWebFormattingNone .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False .Refresh BackgroundQuery:=False End With Next End Sub

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

  • ベストアンサー
  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.1

こんばんは。 >取得したデータが消えず、連続してWEBクエリを実行できるよう下記を添削して頂けませんでしょうか。 結論からいうと、このコードでは不可能なのです。QueryTable というテーブルは、列全体を使っていますが、そこに入れたデータは一回きりです。右側にずらして入れていくという方法もないとは言いませんが、効率が悪いです。QueryTable 専用のシートを作っておいて、そこで、取れたデータを、一旦、別のシートにコピーして写すという方法しか、解決策はありません。QueryTable でWeb データを取得した後の部分にCopy/Paste をつなげればよいのではないかと思います。

kakashi-ka
質問者

お礼

ご回答ありがとうございます!! 試しに、繰り返し処理なしですが、 WEBクエリのデータを取得し、別シートにコピーすることは できました。こちらの方法でリストを作成していきたいと 思います。 不可能だったとは、聞いて良かったです。 聞かなければ、ずっと迷走していました・・・。 ありがとうございました。

関連するQ&A

  • Webクエリで困っています

    以下のマクロを作りました。Webクエリで、セルA1に入力してあるURLを読み込んで表を取り込み、必要なところを選択してコピーするようにしたいのです。しかし、実行すると上から3行目まで黄色になってエラーになります。特に3行目には矢印が表示されています。いろいろ調べましたが結局分かりませんでした。宜しくお願いします。 ------------------------------------------------------ Sub クエリで取得() ' ' クエリで取得 Macro ' マクロ記録日 : 2009/7/30 ユーザー名 : charlie ' ' With ActiveSheet.QueryTables.Add(Connection:= _ Range("A1").Value _ , Destination:=Range("A2")) .Name = "resultlist?tbws=x0p01a&hd=20090716&jcd=01_2" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = False .RefreshOnFileOpen = False .BackgroundQuery = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = False .RefreshPeriod = 0 .WebSelectionType = xlEntirePage .WebFormatting = xlWebFormattingNone .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = True .WebDisableRedirections = False .Refresh BackgroundQuery:=False End With Range("A19:Q54").Select Selection.Copy End Sub ----------------------------------------------------------

  • 連続してWEBクエリを実行

    VBA初心者です。(作業環境Windows7 64bit Excel2010) 現在、WEBクエリを使用し、あるホームページより情報を収集する作業を行っているのですが、 WEBクエリをループさせる技術がない為、作業が難航しております。 具体的に行いたい作業としましては、 A列に商品番号を数種類入れておき、VBAにてURLの後ろにその番号を追加、 つなぎ合わせたURLでホームページにアクセス ⇒ 情報を収集するというものです。 乏しい知識をフル活用し、ループさせずに情報を収集するところまでは作成できたのですが、 どちら様か、ループさせる方法を教えていただける方がおりましたら、ご指導いただけないでしょうか。 ■セルに予め入力する番号例■       A 【1】 131023999 【2】 131022082 【3】 131023869 【4】 131023796 【5】 131044236 ※最終的には、一度に100種類のページにアクセスしたいと考えております。 ■現在作成しているVBAサンプル■ Sub WEBクエリ実行() Dim SIC1 As String Dim SIC2 As String Dim SIC3 As String SIC1 = Range("A1").Text SIC2 = Range("A2").Text SIC3 = Range("A3").Text On Error Resume Next With ActiveSheet.QueryTables.Add(Connection:="URL;http://www.bcn-chubu.jp/search/detailed.php?id=" & SIC1, Destination:=Range("C1")) .FieldNames = True .FillAdjacentFormulas = False .PreserveFormatting = True .BackgroundQuery = True .SaveData = True .AdjustColumnWidth = True .WebTables = "1" .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .Refresh BackgroundQuery:=False End With With ActiveSheet.QueryTables.Add(Connection:="URL;http://www.bcn-chubu.jp/search/detailed.php?id=" & SIC2, Destination:=Range("C31")) .FieldNames = True .FillAdjacentFormulas = False .PreserveFormatting = True .BackgroundQuery = True .SaveData = True .AdjustColumnWidth = True .WebTables = "1" .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .Refresh BackgroundQuery:=False End With With ActiveSheet.QueryTables.Add(Connection:="URL;http://www.bcn-chubu.jp/search/detailed.php?id=" & SIC3, Destination:=Range("C61")) .FieldNames = True .FillAdjacentFormulas = False .PreserveFormatting = True .BackgroundQuery = True .SaveData = True .AdjustColumnWidth = True .WebTables = "1" .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .Refresh BackgroundQuery:=False End With End Sub ちなみに、WEBクエリで収集した情報は、それぞれ指定のセルにアウトプットさせております。 ※30行刻みで情報が書き出されるようになっております。 VBA初心者のため、現在作成しているプログラムが「正しいのか」さえ、判断できていない状況ですが、ご指導いただける方がおりましたら、何卒よろしくお願いいたします。

  • EXCELのwebクエリについての質問です。

    EXCELのwebクエリについての質問です。 よろしくお願いします。 webサイトにあるデータをエクセルに自動で取り込みたいのですが、 そのサイトが、データ100件毎にページを増やしていく仕様なので50ページあったら50回 も手動でデータを取りにいかないといけません。なんとかして自動にしたいのですが・・・ そのサイトはhttp://○×○×.com/page=1/のように"page="に数値を入れれば良いのでエクセルでなんとかなりそうかなと思い質問しました。 ウェブクエリ取得をマクロで記録してみました。 With ActiveSheet.QueryTables.Add(Connection:= _ "URL;http://○×○×.com/page=1", Destination _ :=Range("$A$1")) .Name = "page=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 = "2" .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False .Refresh BackgroundQuery:=False End With この中で、 1."page=1"を連番で連続取得したい。(総ページ数は人的に確認して、どこかに入力できればいいです) 2.エクセルに1つの表にしたいので:=Range("$A$1")だと上書きしていってしまのでどうにかしたい。 3..Name = "page=1"も連番で増やしていきたい。 こんなことは可能でしょうか。 VBAは初心者以下です。 どなたかお助けください。

  • VBA Destinationをアクティブセルに

    VBA練習中の初心者です。アドバイスをお願いいたします。 WEBクエリの操作をマクロに記録したものを編集しています。 そこで、コード内にあるDestinationをactivecellに指定したいのですが、エラーが治りません。(下記コードの、with文の最初の行の部分です) 通常は、Destination:=Range("A1")と記述されていたものを、編集しました。 どこが間違っているかわかりますでしょうか? よろしくお願いいたします。 やりたい操作は、WEBクエリをシート(URLTEST)のB2から下に羅列しているURLを順に表示して、シート(データ)に、指定したテーブルを順に貼り付ける操作です。 他にも間違っている部分があると思いますので、何かあった場合、ご指摘お願いいたします。 Sub WEBクエリ連続取得() Dim I As Integer I = 1 Do If I = 1 Then Worksheets("データ").Activate Range("A1").Select Else Worksheets("データ").Activate Range("A1").End(xlDown).Offset(1, 0).Select End If With ActiveSheet.QueryTables.Add(Connection:="ActiveWorkbook.WorkSheets(""URLTEST"").Cells(""2,I+1"")", Destination:=Activecell) .Name = "151" .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 I = I + 1 'シート”ボタン”に現在の変数を表示する Activebook.Worksheets("ボタン").Range("E6").Value (I) Loop While ActiveWorkbook.Worksheets("URLTEST").Cells("2,I+1") = "" MsgBox "Finish" End Sub

  • エクセルVBA URLの記述をセル参照に

    VBA初心者です。WEBクエリの作業をマクロで記録したものを編集しています。 そこで、コードのURL部分をセル参照にしたいのですが、コンパイルエラーが出るため記述が間違っているようです。もともとが間違っているのかどうかもわからず、その点につきまして、ご教授をお願い申し上げます。 Connection:="URL;http://www.○○○○" ↓編集 (URLを入れているセルは、Sheet1のA1、データを返すのはSheet2のA1) Connection:="ActiveWorkbook.WorkSheets("Sheet1").Range("A1")" "Sheet1"部分が選択された状態でエラーとなります。 以下は、ソースです。 Sub test1() With ActiveSheet.QueryTables.Add(Connection:= _ "URL;http://www.○○○○", Destination:=Range _ ("$A$1")) .Name = "151" .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 End Sub

  • ウェブクエリのマクロが不正な時がある

    お世話になります、 エクセルにウェブクエリのマクロを組み込んで動かしたら 実行結果がOKの場合と駄目な場合があります。 ヤフーの株価ランキングから4ページ分をシートに 落とす処理なのですが7~8回に一度くらいページ があるのに株価表示がないような落ち方をします。 IE6で実行しています。 ソースは '1-4Loop処理 For i = 1 To UBound(urls) 'ワークシート追加 Worksheets("Sheet1").Select Worksheets.Add before:=Worksheets(ActiveSheet.Name) '名前を設定 ActiveSheet.Name = "rank" & i 'webクエリ取得対象シートをアクティブ Set ws = Worksheets("rank" & i) ws.Activate 'QueryTableがなければ追加する If ws.QueryTables.Count = 0 Then 'QueryTableの設定 With ws.QueryTables.Add("URL;", ws.Range("A1")) .RefreshStyle = xlOverwriteCells .AdjustColumnWidth = False .WebSelectionType = xlAllTables .WebFormatting = xlWebFormattingNone .WebTables = "17" End With End If With ws.QueryTables(1) .Connection = urls(i) .BackgroundQuery = True .Refresh BackgroundQuery:=False End With Next 宜しくお願いいたします。

  • エクセルWEBクエリ 貼り付け時の自動変換

    WEBクエリにて、データをシートに張り付ける際、 データの1:1 1:2 3:2などのコロンが間にある文字列が、 ユーザー定義の時間として認識して貼り付けされてしまい困っております。(h:mm) (例) 1:1 1:2 3:2 → 1:01 1:02 3:02 一通り、ヘルプやVBAのヘルプなどを見ましたが、わかりませんでした。 ハイフンで区切られているものは、WEBクエリ中のオプションで日付認識無効をチェックすることで、解決出来るようですが、コロン「:」の解決策は見当たりません。m(__)m もしご存知の方がおられたら、ご教授のほどお願い申し上げます。 そのままの数字が認識できれば、どんな方法でも構いません。 下記は、参考にWEBクエリのマクロ記録そのままの状態です。 Sub Macro5() With ActiveSheet.QueryTables.Add(Connection:= _ "URL;http://www.○○○", Destination:=Range("$A$1") ) .Name = "1122" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .WebSelectionType = xlSpecifiedTables .WebFormatting = xlWebFormattingNone .WebTables = "12" .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = True .WebDisableDateRecognition = True .WebDisableRedirections = True .Refresh BackgroundQuery:=False End With End Sub

  • マクロを使ったWEBクエリでデータが正常にできない

    マクロを使ったWEBクエリでデータが正常に取得できない エクセル2013を使用しております。 下記URLを参考に、マクロでWEBクエリで116ページ分の データ取得用マクロを作成してみたのですが、データ取得が出来ません。 マクロを使用したWEBクエリをご存知の方がいらっしゃいましたら 解決方法をアドバイス頂きたいと思います。 -参考元- http://okwave.jp/qa/q8208492.html 取得したいWEBページ http://www.walkerplus.com/spot_list/ar0300/2.html http://www.walkerplus.com/spot_list/ar0300/3.html ... http://www.walkerplus.com/spot_list/ar0300/117.html 取得用シートに記載したURL 2.html 3.html ... 117.html -作成したマクロです- Sub WEBクエリ実行() Dim St As Object Dim I As Integer Set St = ActiveSheet Sheets.Add After:=Sheets(Sheets.Count) For I = 1 To 116 With ActiveSheet.QueryTables.Add(Connection:="URL;http://www.walkerplus.com/spot_list/ar0300/" & Format(St.Cells(I, 1), "@"), Destination:=Range("C" & (I - 1) * 1000 + 1)) .FieldNames = True .FillAdjacentFormulas = False .PreserveFormatting = True .BackgroundQuery = True .SaveData = True .AdjustColumnWidth = True .WebTables = "1" .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .Refresh BackgroundQuery:=False End With Next I End Sub -マクロは ここまで- 修正箇所のアドバイス もしくは、 他の方法でも、117ページ全て取得可能なマクロをアドバイス頂けると嬉しいです!

  • VBAでデータ更新が遅い

    こんにちは。 たびたびお世話になってます。 今、VBAでYahooファイナンスのサイトからWebクエリでシートに株価データを落として 手元にある、株価の入ったcsvファイルを更新する(新しいデータがあれば更新)マクロを 書いてるんですが、マクロ実行当初はまぁまぁの速さなのですが、株価データは大量に あるため、3000銘柄くらいダウンロードすると、段々と速度が落ちてしまいます。 速度が落ちない良い方法はないでしょうか。 csvはエクセルでオープンしてます。Open文でcsvをテキストとして開いた方が 良いんでしょうか。。とりあえず、Webクエリの部分だけですが、ご教示お願いします。 Sub WebStockGet(ByVal httpUrl As String, ByRef testWs As Worksheet) With testWs.QueryTables.Add(Connection:=httpUrl, Destination:=testWs.Range("A1")) .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .WebSelectionType = xlAllTables .WebFormatting = xlWebFormattingNone .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False .Refresh BackgroundQuery:=False End With End Sub -- エクセル2003

  • VBA一定の範囲内からデータが入っている行を検索

    現在VBAにて作成中です。 内容は、各シートの全く同じ範囲内から1シートへ自動で貼り付けを行い日付順に並べ替えるということです。 各シートは全て同じ表になっていますので、コピー範囲のセル番地は全シート同じです。 コピー範囲は、BF4:BM81で、BF4に日付が入っています。 81行までありますが、82行には、合計行が入っていることや、その下行もデータが入っている為、範囲指定をしています。また、81行設けていますが、上から順にデータは入っているものの、81行まで全て埋まっているとは限りません。 その為、下記のVBAにすると、各シートの81行までのデータが反映され1シートに全てのシート分が貼り付けられるので、かなりの行数になり、空白や0の行が出てしまいます。 範囲内から日付(列BF)のデータが入っている行までを検索し選択、貼り付けを行えるようにしたいと思っています。 どなたかご教授頂ければと思いますのでよろしくお願い致します。 見よう見まねで下記を作成しました。 Sub matome() Dim i As Integer Dim lRow As Long, lCol As Long, lRow4 As Long Application.ScreenUpdating = False '----全データシートの有無をチェックします sh_check '----列見出しをコピーします Worksheets(2).Range("bf1:bm3").Copy Worksheets(1).Range("A1") For i = 2 To Worksheets.Count With Worksheets(i) 左上 = "Bf4" 右下 = "bm81" 範囲 = 左上 & ":" & 右下 lRow = .Cells(Rows.Count, 1).End(xlUp).Row lCol = .Cells(58, Columns.Count).End(xlToLeft).Column '----シートのデータが4行以上の場合にコピーします If lRow >= 4 Then lRow4 = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1 .Activate Range(範囲).Select Selection.Copy Worksheets(1).Cells(lRow4, 1).PasteSpecial Paste:=xlPasteValues End If End With Next i End Sub 説明に不足がありましたら、追って書き込みさせていただきます。

専門家に質問してみよう