みんなの「教えて(疑問・質問)」にみんなで「答える」Q&Aコミュニティ

こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

Excel VBAでのwebクエリ取得データの表示

Excel VBAを使用してwebクエリでSheet1のB2セル~B3、B4、B5・・・と複数のURLからデータをループで取得し、Sheet2のA1セル~A2、A3、A4にて表示しています。
取得データの内容が3行だと仮定(あくまで仮定です)すると、通常であれば以下※1のように表示されると思います。

※1
━━【A】━━━━
【1】B2セルURLの取得内容
【2】B2セルURLの取得内容
【3】B2セルURLの取得内容
【4】B3セルURLの取得内容
【5】B3セルURLの取得内容
【6】B3セルURLの取得内容
【7】B4セルURLの取得内容
【8】B4セルURLの取得内容
【9】B4セルURLの取得内容
・      ・
・      ・
・      ・
━━━━━

これを以下※2のように、取得したデータを横に表示することはできないでしょうか?

※2
━━【A】━━━━━━━━【B】━━━━━━━━【C】━━━━
【1】B2セルURLの取得内容 B2セルURLの取得内容 B2セルURLの取得内容
【2】B3セルURLの取得内容 B3セルURLの取得内容 B3セルURLの取得内容
【3】B4セルURLの取得内容 B4セルURLの取得内容 B4セルURLの取得内容
【4】B5セルURLの取得内容 B5セルURLの取得内容 B5セルURLの取得内容
【5】B6セルURLの取得内容 B6セルURLの取得内容 B6セルURLの取得内容
・      ・          ・          ・
・      ・          ・          ・
・      ・          ・          ・
━━━━━

参考までに以下VBAを使用して、webクエリをループでデータ取得しています。

━━━━━
Sub webクエリ()
  Dim myQT As QueryTable
  Dim i As Long
  Dim myURL As String
  Cells.Delete
  For Each myQT In QueryTables: myQT.Delete: Next
  Range("A1").Select
  For i = 2 To Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Row
    myURL = Sheets("Sheet1").Cells(i, "B").Value
    With QueryTables _
        .Add(Connection:="URL;" & myURL, Destination:=Selection)
      .BackgroundQuery = False
      .AdjustColumnWidth = False
      .WebSelectionType = xlEntirePage
      .WebFormatting = xlWebFormattingNone
      .WebTables = "2"
      .Refresh BackgroundQuery:=False
    End With
    Cells(ActiveCell.Row + QueryTables(1).ResultRange.Rows.Count, 1).Select
  Next
End Sub
━━━━━

当方VBA初心者ですので、できるだけわかりやすくご教授頂けると助かります。
よろしくお願いいたします。

投稿日時 - 2011-01-27 00:34:54

QNo.6477619

すぐに回答ほしいです

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

NO2のjcctairaです。
> ただ、取得データの1行目しか表示されません。
とのことですが、エラーになるので下記のように修正してテストしています。
URLの内容により違うのかも知れませんが、私のテストではうまくいっているようですが?

Sub webクエリ()
  Dim myQT As QueryTable
  Dim i As Long
  Dim myURL As String
  Cells.Delete
  For Each myQT In ActiveSheet.QueryTables: myQT.Delete: Next
  Range("A1").Select
  For i = 2 To Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Row
    myURL = Sheets("Sheet1").Cells(i, "B").Value
    With ActiveSheet.QueryTables _
        .Add(Connection:="URL;" & myURL, Destination:=Selection)
      .BackgroundQuery = False
      .AdjustColumnWidth = False
      .WebSelectionType = xlEntirePage
      .WebFormatting = xlWebFormattingNone
''     .WebTables = "2" ' エラーになるのでコメントアウト
      .Refresh
    End With
    Cells(ActiveCell.Row, "B") = Cells(ActiveCell.Row + 1, "A")
    Cells(ActiveCell.Row, "C") = Cells(ActiveCell.Row + 2, "A")
    Cells(ActiveCell.Row + 1, "A").Select
    Range(ActiveCell.Row & ":" & Rows.Count).Delete
  Next
End Sub

投稿日時 - 2011-01-28 00:01:22

お礼

ありがとうございました!

投稿日時 - 2011-05-12 18:18:52

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(3)

ANo.2

End With以降を修正してください。

【説明】
・取得した3行(縦)を横にコピーします。
・次のデータを取得するために1行ActiveCellを下に
・ActiveCell以降をクリアー
 
 
       :
     End With
     Cells(ActiveCell.Row, "B") = Cells(ActiveCell.Row + 1, "A")
     Cells(ActiveCell.Row, "C") = Cells(ActiveCell.Row + 2, "A")
     Cells(ActiveCell.Row + 1, "A").Select
     Range(ActiveCell.Row & ":" & Rows.Count).Delete
   Next

投稿日時 - 2011-01-27 10:51:27

補足

ありがとうございます。
ただ、取得データの1行目しか表示されません。

投稿日時 - 2011-01-27 21:08:06

ANo.1

すみません。
調べてみましたがwebクエリでテーブルから取得したデータの操作方法が分かりませんでした。

ただ
Cells(ActiveCell.Row + QueryTables(1).ResultRange.Rows.Count, 1).Select

Cells(ActiveCell.Row , 1+ QueryTables(1).ResultRange.Columns.Count).Select
とすれば3行分のデータを縦に書き込んだら
右にデータの項目数分スライドして次のデータを書き込むはずですので、
全てのデータが書き込まれたら縦と横を入れ替えれば似たようなことはできるのではないかと思います。

投稿日時 - 2011-01-27 03:12:04

あなたにオススメの質問