banner2.gifブログランキング・にほんブログ村へ
クリックよろしくお願いします.

2009年03月29日

エクセルで競馬予想4

今回はハイパーリンクをたどってデータを取り込む方法を説明します.

とはいってもなんてことはないです.


With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://db.netkeiba.com/horse/2002100816", Destination:=Range("A20"))

の部分を

myconn = "URL;" & Worksheets("出馬表を貼り付けているシートの名前").Cells(i, 7).Hyperlinks(1).Address
With ActiveSheet.QueryTables.Add(Connection:= _
myconn, Destination:=Cells(j, 2))

に変えるだけです.
つまり,アドレスをmyconnという文字に置き換えるだけです.
「出馬表を貼り付けているシートの名前」のi行7列目のアドレスを
読み込み,そのデータをj行2列目に貼り付けるということです.

※i行7列目にハイパーリンクの位置が来るようにnetkeibaの出馬表をコピペしなければなりません.

ここでiを○〜○+18までと繰り返し計算をすることで,馬番が1〜18までのアドレスを順々に読み込み,データを取り込むことができます.
そしてjを▲〜▲まで繰り返し計算をすることで,データを順々に貼り付けることができます.


これで基本的なデータの取り込み方は終了.

しかし,前回も言いましたが少し問題点があります.

.WebTables = "35"

の部分の番号は「webページのどの場所をとりこむか」ということを表しています.
しかしこれが厄介なことに,馬によって,たとえば掲示板への書き込み量や広告の量などによって数字が変わってきます.
これを解決するために,


"35"

の部分としてkのような文字をおき,kを色々変化させ繰り返し計算を行い,正しい部分が貼り付けられるまで,同じ操作を繰り返します.

正しい部分が取り込まれた場合,貼り付けられた一番左上のセル(j,2)は必ず「日付」という文字になります.

ですので,取り込むプログラムを


Do Until Cells(j, 2) = "日付"



k = k + 1
Loop

で挟んであげることによって,問題が解決します.

最後に前々回も示しましたが,データを取り込むプログラムをまとめるとこのようになります.


Sub データ取り込み()

!前にあったデータをクリア
Range("B3:AJ1000").Select  !データを貼り付けているセルの範囲
Selection.ClearContents

!データの取り込み
i = 13  !ハイパーリンクの開始位置(行)
Do   !繰り返し計算
j = i * 53 - 686  !データの貼り付け位置(行).データの貼り付け開始位置は13×53-686=3行目になる.また,この場合1頭につき,53行分のデータが取り込める.
k = 32   !web上のデータの取り込み位置
Do Until Cells(j, 2) = "日付"  !セル(j,2)が「日付」という文字になるまでkを1ずつ変化させ動作を繰り返す.
Cells(j, 2).Select

!データの取り込み部分
myconn = "URL;" & Worksheets("出馬表を貼り付けたシート").Cells(i, 7).Hyperlinks(1).Address  !出馬表を貼り付けたシートのセルi行7列目
With ActiveSheet.QueryTables.Add(Connection:= _
myconn, Destination:=Cells(j, 2)) !出馬表を貼り付けるセルj行2列目
.Name = Worksheets("出馬表を貼り付けたシート").Cells(i, 7)
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = k  !各馬のページにおいて取り込む部分.k番目のデータ
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = True
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
k = k + 1
Loop

i = i + 1
Loop Until i = 31

End Sub


iとjの数字は各人の貼り付け位置にあわせて自由に変えていけばいいと思います.
posted by YSM at 13:28| 大阪 ☁| Comment(0) | TrackBack(0) | 日記 | このブログの読者になる | 更新情報をチェックする
この記事へのコメント
コメントを書く
お名前:

メールアドレス:

ホームページアドレス:

コメント:

認証コード: [必須入力]


※画像の中の文字を半角で入力してください。

この記事へのトラックバック
×

この広告は1年以上新しい記事の投稿がないブログに表示されております。