エクセルＷＥＢクエリで毎回変わるＵＲＬに対応したい

質問

中央競馬の結果成績をＷＥＢクエリで自動取得したいと思ったのですが、ＵＲＬの一部が毎回変わります。
日付、開催場、第何回か、何一目か、これらの要素で変化します。
それを認識して設定した通りに取得したいのです。

現在、日付ごとに競馬のデータを１つのＢｏｏｋとして保存しています。
各レース別にシートを分けています。
最大３場開催なので、３６シートあります。

例えば２００８年８月２４日のＢＯＯＫに、２００８年８月２４日第３回新潟４日目の３レースの結果を、
シート３の指定のセル（Ａ３０）にテキスト形式で貼り付けます。
つまり各レースの結果をそれぞれのレース別に分けたシートの指定のセルに貼り付けるということを、自動取得で出来ないでしょうか？

結果はＹＡＨＯＯ競馬でも良いのですが、
こちらのサイトの方がシンプルなのでこれを使ってみました。
http://www.keibabook.co.jp/homepage/freeraceinfo/tojitu/sokuhoinfo.aspx?subsystem=0
２００８年８月２４日第３回新潟４日目ならこちら
http://www.keibabook.co.jp/homepage/freeraceinfo/tojitu/sokuhoinfo2.aspx?subsystem=0&negahi=20080824&kai=03&basyocd=07&kaisai=04

ＵＲＬのkai=03&basyocd=07&kaisai=04の部分が第３回（０３）新潟（０７）４日目（０４）になっています。

当日の開催中は徐々に行数が増えていきますので、まだ表示されていないレースの行を指定できませんでした。

また、結果で同着が起きた場合、そのレースだけ行数が増えます。
そんな時はこのような表示になります。
http://www.keibabook.co.jp/homepage/freeraceinfo/tojitu/sokuhoinfo2.aspx?subsystem=0&negahi=20080817&kai=03&basyocd=07&kaisai=02

理想としてはその日の名前を（２００８年８月２４日第３回新潟４日目）をどこかのセルに入れたら、
それを認識してその日の結果のページにデータを取得しに行く事が出来れば良いのです。（入力は各開催場で１回のみ）

自分なりに考えてやってみた事は、日付別のＢＯＯＫとは別に結果取得用のＢＯＯＫを作り、
それのシート１～３にそれぞれの開催場の結果をリアルタイムに取得できるようにしました。
本日の場合なら、シート１新潟、シート２小倉、シート３札幌という風にです
ＷＥＢクエリで取得に指定した範囲は各開催場の結果全体です。
これで結果が更新される度に表示されました。（５分間隔設定）
それを日付別のＢＯＯＫからマクロで結果取得用のＢＯＯＫに取得しに行く事にしましたが、
結果が同着になると行がずれてくるためにコピーしてきたものが目的の内容とは違う行になってしまいました。
また毎回その日のＵＲＬでＷＥＢクエリを設定する必要があります。

何か良い方法を教えてください。
マクロで出来るならそのマクロコードを教えてください。

マクロコードにはどんな動作をさせてるコードなのかも書いて頂けるとありがたいです。
宜しくお願いします。

回答No.7

Wendy02 · ベストアンサー

こんにちは。

>１グループを指定のシートに振り分ける
問題は、「指定のシート」というところです。

ダミーシートから切り分けることの問題ではなく、受け取る側のシートの配分なのです。ビジネスの場合、同じような質問は、それは、ほとんどが、月度とか、明確に分類が知られていているので出来るのです。

しかし、今回のは、こちらからすると、36シートのシートへの分類自体が、分からないのです。それを、データからではなく、おそらく、最終的には、URLから、シート名の変換コードを作ることによって、分類しなくてはならないように思っています。

切り分けのサンプル程度なら、以下のように作れますが、それ以上は、難しいです。

そうしたものを、回答者自身側が、調べたり勉強したりして構築するには、時間が掛かる作業だと感じています。こちらには、そのための知識の蓄積がありません。その趣味のある人で、ある程度のVBAの心得のある人以外は、やはり掲示板の質問の範囲としては越えているように思うのです。

それと、経験的に、私は、この手の質問では、最後まで完成させても、意味のないものになってしまったというケースが往々にしてあったからです。多くの原因は、依頼者との最終的な出来上がりや最終使用段階の十分な確認が出来ていないということと、こちら側に、ベースとなる十分な知識がなかったことがあげられます。無理にお願いされて、結局は、ダメになったケースもかなりあるのです。

だから、難しいと思うのです。

ただ、言葉だけでは納得しないでしょうから、サンプルコードは提示しておきます。

参考にしてみてください。特に、詳しいサポートをするつもりはありません。

'---------------------------------------------
シート名は、1R,2R,3R ......12R としています。
また、インポート用の"Dummy" というシートが必要です。

(ただしすべて半角です。以前から、Excel2003に関しては、シート名に関して全角・半角の問題に、不明の誤動作があるようです。）

シートの半角修正コードは以下のとおりです。
'-------------------------------------------
Sub SheetNameCheckers()
'シート名のチェック(シート名を半角にする）
Dim sh As Worksheet
Dim nSh As String
　For Each sh In Worksheets
　 If sh.Name Like "#*" Then
　　nSh = StrConv(sh.Name, vbNarrow)
　　Worksheets(sh.Name).Name = nSh
　 End If
　Next sh
End Sub

Sub SheetsAllClear()
'該当シートを全部消去
Dim sh As Worksheet
　For Each sh In Worksheets
　 If sh.Name Like "#*" Then　　'最初が数字のシート
　　Worksheets(sh.Name).Cells.Clear
　 End If
　Next sh
End Sub
'---------------------------------------------
'実行プログラム(１回きり）
'Sheet1 のA1 から、このように書く
日付　　　回　　　場所　　日目
20080823　　3　　　　3　　　3
20080823　　3　　　　7　　　3

'---------------------------------------------
'標準モジュール
'Option Explicit

Private Const BASEURL As String = "http://www.keibabook.co.jp/homepage/freeraceinfo/tojitu/sokuhoinfo2.aspx?"
Private myTime As Date
Private k As Integer
Sub ImportKeibaData()
　　'trial code
　　Dim myUrl As String
　　Dim myDate As Variant
　　Dim iKai As Variant
　　Dim iBasyo As Variant
　　Dim iKaisai As Variant
　　Dim i As Integer
　　Dim iflg As Integer

　　With Worksheets("Sheet1")
　　　 .Activate
　　　 '2行目からです。
　　　　For i = 2 To .Range("A65536").End(xlUp).Row

　　　　　　If IsNumeric(.Cells(i, 1).Value) And Len(.Cells(i, 1).Value) = 8 Then
　　　　　　　　myDate = Cells(i, 1).Text '"20080824"
　　　　　　Else
　　　　　　　　iflg = 1
　　　　　　End If
　　　　　　If IsNumeric(.Cells(i, 2).Value) Then
　　　　　　　　iKai = Format$(.Cells(i, 2).Value, "00")
　　　　　　Else
　　　　　　　　iflg = iflg + 1
　　　　　　End If
　　　　　　If IsNumeric(.Cells(i, 3).Value) Then
　　　　　　　　iBasyo = Format$(.Cells(i, 3).Value, "00")
　　　　　　Else
　　　　　　　　iflg = iflg + 1
　　　　　　End If
　　　　　　If IsNumeric(.Cells(i, 4).Value) Then
　　　　　　　　iKaisai = Format$(.Cells(i, 4).Value, "00")
　　　　　　Else
　　　　　　　　iflg = iflg + 1
　　　　　　End If

　　　　　　If iflg <> 0 Then
　　　　　　　　If MsgBox(i & "行目のデータが抜けているようです。Cacel:中止", _
　　　　　　　　　　vbInformation + vbOKCancel, "エラー") = vbCancel Then
　　　　　　　　　　Exit Sub
　　　　　　　　End If
　　　　　　End If

　　　　　　myUrl = BASEURL & "subsystem=0&negahi=" & myDate & "&kai=" & iKai & "&basyocd=" & _
　　　　　　iBasyo & "&kaisai=" & iKaisai
　　　　　　Call ImportData(myUrl, "Dummy", "A1")
　　　　　　Call SeparateData
　　　　　　.Cells(i, 7).Value = Time

　　　　　　.Activate
　　　　Next i
　　End With
End Sub
Sub ImportData(url As String, nSh As String, nAdd As String)
Dim qt As QueryTable
　　Worksheets(nSh).Activate
　　Worksheets(nSh).UsedRange.Clear
　　For Each qt In Worksheets(nSh).QueryTables
　　　qt.Delete
　　Next

　　With Worksheets(nSh).QueryTables.Add(Connection:="URL;" & url, Destination:=Range(nAdd))
　　　　.Name = Mid(Replace(url, BASEURL, "", , , 1), 2)

　　　.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 = "3"
　　　　.WebPreFormattedTextToColumns = True
　　　　.WebConsecutiveDelimitersAsOne = True
　　　　.WebSingleBlockTextImport = False
　　　　.WebDisableDateRecognition = True
　　　　.WebDisableRedirections = False
　　　　.Refresh BackgroundQuery:=False
　　End With
End Sub
Sub SeparateData()
'データ切り分けコード
　　Dim a As Range
　　Dim r As Range
　　Dim nSh As String
　　With Worksheets("Dummy")
　　　　On Error Resume Next
　　　　For Each a In .UsedRange.Columns(1).SpecialCells(xlCellTypeConstants, 23).Areas
　　　　　　With a.CurrentRegion
　　　　　　nSh = Mid$(Trim(a.Cells(1).Value), 1, InStr(Trim(a.Cells(1).Value), Space(1)) - 1)
　　　　　　nSh = StrConv(nSh, vbNarrow)
　　　　　　If nSh <> "" Then
　　　　　　.Copy Worksheets(nSh).Range("A65536").End(xlUp).Offset(1)
　　　　　　End If
　　　　　　End With
　　　　Next
　　　　On Error GoTo 0
　　　　.Cells.ClearContents 'データの消去
　　End With
End Sub

お礼

私の質問の内容が不明瞭でご迷惑をお掛けしました。
申し訳ありません。
何度も回答頂きありがとうございました。

それから最終的にサンプルを提示して頂きましたが、
残念ですがエラーになり実行できませんでした。
（サイトのアドレスが正しくありません・・・・）

回答No.9

Wendy02

こんにちは。

>貼り付けただけではなく、きちんとhttp～2.aspx?までを入れています。それでも駄目なんですよね・・・。

後は、最初にされたと同じようにしていただくしかないのですが。
こちらでは、問題なく作動しています。サンプル・ブックをお渡しすることは、ここでは、禁じられていますので、なんとか、ご自身の力で解決してください。

Sub ImportKeibaData()
--省略--
　iBasyo & "&kaisai=" & iKaisai　　(この下に、）
　MsgBox myUrl 　'とを置けば、そのURLの内容は見られます。
　　　　　　Call ImportData(myUrl, "Dummy", "A1")

できれば、ブックを変えて、標準モジュールを設けて書いていただければ、問題はなかろうと思います。

マクロ文の中で示したように、

実行プログラム(１回きり）
'Sheet1 のA1 から、このように書く
日付　　　回　　　場所　　日目
20080823　　3　　　　3　　　3　(これ以降書かない）
20080823　　3　　　　7　　　3　

　↑
数値で示すこと

シート名は、
1R,2R,3R ......12R としています。
また、どこでもよいので、インポート用の"Dummy" というシートが必要です。

1R ～12R までの「半角」シート名を入れていただくこと。

一度、シートの半角修正コードを試していただければ、確実です。

半角確認・修正用のマクロ　Sub SheetNameCheckers()

お礼

ありがとうございました。
シート名チェックとかシート削除とかのマクロを、
削除したら動くようになりました。
お世話になりました。

回答No.8

Wendy02

こんばんは。

>サイトのアドレスが正しくありません・・・・
それについては、前回説明したとおり、貼り付けただけでは、ここのサイトでは、正しく写されません。#4の書き込みをごらんください。

補足

お世話になります、
貼り付けただけではなく、きちんとhttp～2.aspx?までを入れています。それでも駄目なんですよね・・・。

回答No.6

n-jun

横からですが。ANo.1です。

>うまく内容が伝わっていないようです、すみません。
>そんなに大袈裟なものではないのです。
最初の質問の段階で結構なものだと思いましたよ。
それでソフトの使用を薦めたのです。
質問者さんがＶＢＡの経験が長いから、大袈裟に感じないのでしょう。
個人的にはANo.5さんの意見に賛同しています。

仮に１シートに１２レースのデータが取得できたのであれば、あとの切り分けは
レース名を対象としてデータの下から順に検索し、最下行とレース名のある行で１つのレース結果とし、
別シートに切り取り・貼り付けを行なうだけのように思いますけど。

お礼

ありがとうございました。
因みに私はＶＢＡどころかエクセルも初心者です、
マクロの自動記録でしかマクロは出来ません。
教えて頂いたコードを自分の目的の内容に当てはめて使用するしか出来ません。
それで自分の意図した内容がそれほど難しい内容とは思っていませんでした。すみません。

>仮に１シートに１２レースのデータが取得できたのであれば、あとの切り分けは
>レース名を対象としてデータの下から順に検索し、最下行とレース名のある行で１つのレース結果とし、
>別シートに切り取り・貼り付けを行なうだけのように思いますけど。
仰る通りです、それを自分の知ってる範囲の知識で試みましたが、
出来なかったので質問しました。

回答No.5

Wendy02

こんばんは。

一応、この件はお答えしておきます。

>Ｂ１に日付ですよね？
>2008/08/23と入れました。

ここは迷いました。単に、書式のユーザー設定で、「yyyymmdd」にしていただいてもよいです。

もちろん、セルの状態を無視して、VBAで、シリアル値から、直す方法は、

　 If IsNumeric(.Cells(i, 1).Value) Then
　　myDate = Format$(Cells(i, 1).Value,"yyyyMMdd")　'"20080824"
　　Else
　　iflg = 1
　　End If

とすればよいです。

>１シートに１レースのデータを保存しています。色々分析したデータをレース毎に分けています。

ということは、１レースは、１レースでのみで、下に貯めていくことでしょうか。
意味は分かりました。どこまで(３行--３馬のみなのか、それ以上にするのか）のデータをリスト化するか分かりませんが、それで、36シートということですか？もし、そうですと、出来る出来ないというよりも、全体の仕上がりが予想できなければ、無理ですね。

一旦、ダミーシートを置いておいて、そこから切り分ける方法でも可能かとは思います。
途中までは、そのコードは活かせるはずですが、その後が問題でしょう。

そして、取得する部分のURLを、決まった名や、0823030303 などの、そのデータに対するIndex 番号が必要のようです。そうしないと、後で、そのデータがどこからなのか内容が分からなくなってしまいます。通常では、そのままデータベースに移すことも出来ません。

今は、仕上がり段階のイメージも出来ておりませんから、ちょっと違うから直して、というだけで済む話ではなくなります。

これ以上は、無償の範囲では難しいと思ったほうがよいです。別の掲示板でお聞きになってみてもよいと思います。

一応、私自身は、長く、あちこちで書き込みをしていますが、利益性のあるものや、ビジネス用などのご依頼は、簡単なものならともかく、ある規模になるとチュウチョしてしまいます。また、そのマクロ自体には、あまり汎用性があるのでもなさそうな気がします。実際に、有償で、どなたかにご依頼なさってもよいと思います。

補足

何度もありがとうございました。
うまく内容が伝わっていないようです、すみません。
そんなに大袈裟なものではないのです。

１Ｒ ２歳未勝利
1 1 1 メイクデュース 単 勝 1 550円 複 勝 1 220円
2 8 13 ホーマンライズ 枠 連 1-8 1,060円 13 230円
3 5 7 ハイフィールド 馬 連 1-13 1,160円 7 330円
馬 単 1-13 2,630円 ワイド 1-13 410円
３連複 1-7-13 2,610円 1-7 540円
３連単 1-13-7 13,440円 7-13 610

上記を１グループとして１シートに取得するだけで良いのです。
それ以外は必要ありません。

全レース分取得したところから上記の１グループを指定のシートに振り分けるだけでも良いのですが・・・。

回答No.4

Wendy02

#3の補足：

Webの出ているものを見ましたら、切れています。

Private Const BASEURL As String ="http://www.keibabook.co.jp/homepage/freeraceinfo/tojitu/sokuhoinfo2...

このまま貼り付けると、...　と切れてしまいますから、改めて入れなおしてください。

BASEURL のURL は、元のURL の
...sokuhoinfo2.aspx?
までです。

それから、
1行目　日付　　　回　場所　日目　シート名　セル　収録時間 (取得回数）
2行目　20080823　　3　　3　　3　　Sheet2　　A30　

場所の3　というのは、分かりにくいようでしたら、もう少し、工夫が必要かもしれません。
入力規則を使って場所を出して、それを、VLOOKUP を使って、別のセルに、数字を出してあげ、それを、マクロで読ませることも可能ですね。

補足

お世話になります、
No.３の補足を投稿してる間にNo.４を見逃していました。
実行して表示できるようになりましたが、
No.３の補足でも書きましたが、レース別にシートを分けて取得したいので、今の状態だと、普通にＷＥＢクエリで実行した時と同じ状態です。
申し訳ありませんがシートに分ける方法をお願い出来ないでしょうか？

回答No.3

Wendy02

こんにちは。

私は、ぜんぜん、競馬が分からないので、ちゃんと教えてくだされば、出来ると思います。(今は、時間的余裕がないのですが、競馬のマクロは、素人がマクロに手を出す材料としては、非常に魅力のあるもののひとつです。その専門のマクロの本まで出ています。ただし、利殖が目的なので、ほとんどの人は、この本の内容が理解できないそうですが。この競馬の分野には、プロの方もいれば、Webでも、専門にやっている人も何人もいるみたいです。）

今回、見てみましたが、構造的にはマクロは難しくないのですが、私は、その競馬自体の仕組みが分かってこないのです。

５分間隔というのも、そんなに問題ではないと思います。同着が起きたときに狂ってしまうのは、既存の機能を使うからなのですね。それは、大したことではありません。

>最大３場開催なので、３６シートあります。
まず、どのようにシートを管理していくか、ということです。

開催場所　3　×　12　の12は、日付のことでしょうか？

大雑把にマクロを考えてみました。

>理想としてはその日の名前を（２００８年８月２４日第３回新潟４日目）をどこかのセルに入れたら、

サンプルコードとして、シートの数の管理は別として、シート1の1行目に入れてみてくださいますか？

Sheet1 に、
　　　　A　　　　B　　 C　　D　　　 E　　　 F　　G　　　　　H
1行目　日付　　　回　場所　日目　シート名　セル　収録時間 (取得回数）
2行目　20080823　　3　　3　　3　　Sheet2　　A30　
2行目　20080823　　3　　7　　3　　Sheet3　　A20　

シート名とか、アドレスは、きちんと合わせてください。間違えると、マクロは、継続されません。

マクロの登録場所は、シートに左右されない標準モジュールがよいです。

また、ボタンは、フォームボタンが簡単でよいのですが、
ボタン1は、"TimerSet" で、ボタン2は、"TimerSetOff" たぶん、こちらは使う必要がないけれども、異常終了したときには、一度、こちらのマクロを使ってください。値がリセットされます。

上限の回数　というのは、更新の数のことです。

'-------------------------------------

Private Const BASEURL As String = "http://www.keibabook.co.jp/homepage/freeraceinfo/tojitu/sokuhoinfo2.aspx?"
Private myTime As Date
Private k As Integer
Private Const iJOGEN As Integer = 5 '上限の回数
Sub TimerSet()
　　'タイマーの設定
　　myTime = Now + TimeSerial(0, 5 * k, 0) '5分ごと
　　k = k + 1
　　If k > iJOGEN Then
　　　　k = 0
　　　　myTime = 0
　　　　MsgBox "終了しました。", vbInformation
　　　　Exit Sub
　　Else
　　　　Application.OnTime myTime, "ImportKeiba", myTime + TimeSerial(0, 0, 30)
　　End If
End Sub
Sub TimerSetOff()
'タイマーを止める
On Error GoTo ErrMsg
Application.OnTime myTime, "ImportKeiba", , False
ErrMsg:
If Err.Number > 0 Then
　MsgBox "タイマーがセットされていないか、解除できませんでした。", 48
Else
　MsgBox myTime & "のタイマーを解除しました。"
End If
myTime = 0
k = 0
End Sub
Sub ImportKeiba()
　　'trial code
　　Dim myUrl As String
　　Dim myDate As Variant
　　Dim iKai As Variant
　　Dim iBasyo As Variant
　　Dim iKaisai As Variant
　　Dim ret As Variant
　　Dim i As Integer
　　Dim iflg As Integer
　　Dim nSheet As String
　　Dim nAddress As String

　　With Worksheets("Sheet1")
　　　 .Activate
　　　 .Cells(1, 8).Value = k & "回目"
　　　 '2行目からです。
　　　　For i = 2 To .Range("A65536").End(xlUp).Row

　　　　　　If IsNumeric(.Cells(i, 1).Value) And Len(.Cells(i, 1).Value) = 8 Then
　　　　　　　　myDate = Cells(i, 1).Text '"20080824"
　　　　　　Else
　　　　　　　　iflg = 1
　　　　　　End If
　　　　　　If IsNumeric(.Cells(i, 2).Value) Then
　　　　　　　　iKai = Format$(.Cells(i, 2).Value, "00")
　　　　　　Else
　　　　　　　　iflg = iflg + 1
　　　　　　End If
　　　　　　If IsNumeric(.Cells(i, 3).Value) Then
　　　　　　　　iBasyo = Format$(.Cells(i, 3).Value, "00")
　　　　　　Else
　　　　　　　　iflg = iflg + 1
　　　　　　End If
　　　　　　If IsNumeric(.Cells(i, 4).Value) Then
　　　　　　　　iKaisai = Format$(.Cells(i, 4).Value, "00")
　　　　　　Else
　　　　　　　　iflg = iflg + 1
　　　　　　End If
　　　　　　If .Cells(i, 5).Value <> "" Then
　　　　　　　　nSheet = Cells(i, 5).Value
　　　　　　Else
　　　　　　　　iflg = iflg + 1
　　　　　　End If
　　　　　　If .Cells(i, 6).Value <> "" Then
　　　　　　　　nAddress = Cells(i, 6).Value
　　　　　　Else
　　　　　　　　iflg = iflg + 1
　　　　　　End If

　　　　　　If iflg <> 0 Then
　　　　　　　　If MsgBox(i & "行目のデータが抜けているようです。Cacel:中止", _
　　　　　　　　　　vbInformation + vbOKCancel, "エラー") = vbCancel Then
　　　　　　　　　　Exit Sub
　　　　　　　　End If
　　　　　　End If

　　　　　　On Error Resume Next
　　　　　　ret = Worksheets(nSheet).Range(nAddress).Value
　　　　　　If Err.Number > 0 Then
　　　　　　　　MsgBox nSheet & "!" & nAddress & "が、存在しないかもしれません", _
　　　　　　　　vbInformation, "エラー"
　　　　　　　　Exit Sub
　　　　　　End If
　　　　　　ret = ""
　　　　　　On Error GoTo 0

　　　　　　myUrl = BASEURL & "subsystem=0&negahi=" & myDate & "&kai=" & iKai & "&basyocd=" & _
　　　　　　iBasyo & "&kaisai=" & iKaisai
　　　　　　Call ImportData(myUrl, nSheet, nAddress)
　　　　　　.Cells(i, 7).Value = Time
　　　　　　.Activate
　　　　Next i
　　End With
　　If k <= iJOGEN Then
　　　Call TimerSet
　　End If
End Sub
Sub ImportData(url As String, nSh As String, nAdd As String)
Dim qt As QueryTable
　　Worksheets(nSh).Activate
　　Worksheets(nSh).UsedRange.Clear
　　For Each qt In Worksheets(nSh).QueryTables
　　　qt.Delete
　　Next

　　With Worksheets(nSh).QueryTables.Add(Connection:="URL;" & url, Destination:=Range(nAdd))
　　　　.Name = Mid(Replace(url, BASEURL, "", , , 1), 2)

　　　.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 = "3"
　　　　.WebPreFormattedTextToColumns = True
　　　　.WebConsecutiveDelimitersAsOne = True
　　　　.WebSingleBlockTextImport = False
　　　　.WebDisableDateRecognition = True
　　　　.WebDisableRedirections = False
　　　　.Refresh BackgroundQuery:=False
　　End With
　　With Worksheets(nSh)
　　　　.Columns(6).HorizontalAlignment = xlCenter
　　　　.Columns(7).HorizontalAlignment = xlRight
　　　　.Columns(9).HorizontalAlignment = xlLeft
　　　　.Columns(10).HorizontalAlignment = xlRight
　　End With
End Sub

補足

なんか凄い回答ありがとうございます。
私の説明不足ですみません。
３場開催で１Bookに３６シートというのは、
通常は特別な事が無い限り、１場で１２レースまであります、
それが３場で３６レースという意味です。
１シートに１レースのデータを保存しています。
色々分析したデータをレース毎に分けています。
そのデータの中で成績結果の数値を使用するために、
レース毎に適合したレースのシートに結果を入力したいということです。

教えて頂いたマクロコードをそのまま貼り付けて実行したところ、
何も取得できませんでした。
Private Const のところから貼り付けるのですね？
実行した回数だけ回数のところが増えるだけです。
Ｂ１に日付ですよね？
2008/08/23と入れました。
隣のセルから3　　3　　3　　Sheet2　　A30　
と入れてみました。
Ａ１から入れてみたら「２行目のデータが抜けているようです」と表示が出てエラーになります。
私にはさっぱり分かりません、すみませんどうしたら良いのでしょうか？

回答No.2

hige_082

私も競馬には興味ないので
適当に検索したら、ヒットしたので紹介します

http://kyousya28.ybl.jp/blog.php?m=3&s=2007-11&p=2

参考までに

お礼

回答ありがとうございます。
ご紹介して頂いたサイトとはちょっと目的が違うようです。

回答No.1

n-jun

直接の回答ではないですが、結果を取得できるソフトって昔見たような
気もするのですが、そう言うのを利用することは検討されてはいないのでしょうか？
競馬自体やらないので、今あるのかどうかはわかりません。

でもＶＢＡで悩むよりかは楽なように思えます。
もし今は存在しないようでしたら、スル～願います。

補足

アドバイスありがとうございます。
ソフトなら何種類か持っています。
結果も出ます。
そうではなくて自分の調べ上げた分析データのエクセルに表示させなければ出来ない作業があるのです。