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

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

締切り済みの質問

連続して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初心者のため、現在作成しているプログラムが「正しいのか」さえ、判断できていない状況ですが、ご指導いただける方がおりましたら、何卒よろしくお願いいたします。

投稿日時 - 2013-08-06 17:18:33

QNo.8208492

困ってます

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

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

回答(1)

こんにちわ。
こちらでいけると思います。

Sub WEBクエリ実行()

Dim St As Object
Dim I As Integer

Set St = ActiveSheet

Sheets.Add After:=Sheets(Sheets.Count)
For I = 1 To 5
With ActiveSheet.QueryTables.Add(Connection:="URL;http://www.bcn-chubu.jp/search/detailed.php?id=" & Format(St.Cells(I, 1), "@"), Destination:=Range("C" & (I - 1) * 30 + 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

投稿日時 - 2013-08-24 14:32:44

あなたにオススメの質問