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

1999年01月01日

データ取り込みマクロのソース

Sub データ取り込み()

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

!データの取り込み
i = 13  !ハイパーリンクの開始位置(行)
Do   !繰り返し計算
j = i * 53 - 686  !データの貼り付け位置(行)
!iとjは出馬表を貼り付ける位置と,データを貼り付ける位置によって変わる.
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 !13〜31の計18回(18頭分動作を繰り返す)

End Sub
posted by YSM at 23:05| 大阪 ☁| Comment(0) | TrackBack(0) | 日記 | このブログの読者になる | 更新情報をチェックする
この記事へのコメント
コメントを書く
お名前:

メールアドレス:

ホームページアドレス:

コメント:

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


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

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

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