dポイントプレゼントキャンペーン実施中!

OS:WIN XP
EXCEL2000使用

EXCELから簡易データ取得を行いたいとおもっています。
マクロ化しVBAをいじって複数のページデータを取得したいと考えています。

取得したいページのURLが
http://hogehoge.com/0000XXX.html
XXX部分が数字で001~100まで可変すると想定。
001~100までのデザインは同じ。

1~100までをそれぞれSHEET1~SHEET100までに貼り付けたいとおもっています。
その際に邪魔なA列と1~5行目を削除とする場合
どのような記述に変更すればよいのでしょうか。


ページの取得までは出来るのですが
VBAがあまりよくわからないので質問させていただきました。
宜しくお願い致します。

下記001.htmlだけを取得したものになります。

With ActiveSheet.QueryTables.Add(Connection:="URL;​http://hogehoge.com/0000001.html",​ _
Destination:=Range("A1"))
.Name = "ExternalData_1"
~800文字に収まらないため中略~
.WebDisableDateRecognition = False
.Refresh BackgroundQuery:=False
End With
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Rows("1:5").Select
Selection.Delete Shift:=xlUp
Range("A1").Select
End Sub

A 回答 (3件)

> Sheets("SHEET" & Num).Activate


> のところでデバックが発生してしまいまして・・

SHEET1~SHEET100というシートはあらかじめ作っているわけではないのでしょうか。
それなら、以下のマクロを貼り付けて、1回実行してください。
URL1~URL100というシートが自動的に作成されます。(SHEET1とすると既存のシート名とかぶったときにエラーになったのでシート名を変えました)

Sub AddSheets()
  Dim i As Integer
  Worksheets.Add Count:=100
  For i = 1 To 100
    Sheets(i).Name = URL" & i
  Next i
End Sub

なお、シート名を変えたので、先の回答の
Sheets("SHEET" & Num).Activate
という箇所を
Sheets("URL" & Num).Activate
に変更してください。
    • good
    • 0
この回答へのお礼

おおおおおお!!!!
なんとかいけそうです。
収集しているものが001~100までだったり
1~150がなく237~とかいうページもあったりで
シートを最初から作っていない感じでした。

またわからなければ質問致します!
丁寧なご回答ありがとうございました!!

お礼日時:2006/10/18 13:40

No.1です。

すみません、ケアレスミスがありました。

Format(Num, "000") & ".htm"
でなくて
Format(Num, "000") & ".html"
でした。
    • good
    • 0

お書きになったVBAを標準モジュールに記述し、引数でシート番号を指定してForループで001~100までを処理したらいいのではないでしょうか。



質問文のプロシージャ名を仮にGetURLとすると、
Sub GetURL(Num As Integer)
と定義し、
"URL;​http://hogehoge.com/0000001.htm"
の部分(なんか文字化けしてますね)を、
"URL;​http://hogehoge.com/0000" & Format(Num, "000") & ".htm"
と修正すると、以下のマクロで1~100まで処理できると思います。

Sub GetAllURL()
Dim Num As Integer
For Num = 1 To 100
Sheets("SHEET" & Num).Activate
GetURL (Num)
Next Num
End Sub

質問の意味を誤解していたらすみません。

この回答への補足

やはり文字化けしてしまいますね(^^;

補足日時:2006/10/16 21:25
    • good
    • 0
この回答へのお礼

ご解答ありがとうございます。
お礼が遅くなってしまい申し訳ございません。
しばらくやってみたのですが;;;

Sheets("SHEET" & Num).Activate
のところでデバックが発生してしまいまして・・
Sub GetURL(Num As Integer)
With ActiveSheet.QueryTables.Add(Connection:=URL;​http://hogehoge.com/0000"​ & Format(Num, "000") & ".htm",​ _
Destination:=Range("A1"))
中略
Range("A1").Select
End Sub
Sub GetAllURL()
Dim Num As Integer
For Num = 1 To 100
Sheets("SHEET" & Num).Activate
GetURL (Num)
Next Num
End Sub
↑でいけるものなのでしょうか?

お礼日時:2006/10/16 21:25

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!