[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『競馬の出馬表をサイトから抽出したのですが』（競馬すき）
はじめまして！
マクロで競馬の出馬表をサイトから抽出したのですが
抽出したところ
ハイスペックマン ｜ ワールドエース
牡2/鹿毛 小桧山 悟(美浦) ｜ エーシンレベルハイ
となってて
それを
ハイスペックマン｜ 牡2/鹿毛 小桧山 悟(美浦)｜ ワールドエース｜ エーシンレベルハイ
みたいにしたいのですがどうすればよろしいでしょうか
よろしくおねがいします
＜ 使用 Excel：Excel2019、使用 OS：Windows10 ＞
>マクロで競馬の出馬表をサイトから抽出したのですが >抽出したところ
どこのサイトから、どのようなコードで抽出したのでしょう？ （通りすがり） 2021/07/23(金) 19:02
最近競馬関連の質問が多いような・・・。
[[20210118174756]] 『ここって』（ヒロユキ）
[[20210629194817]] 『コードが動かなくなりました』（うーん）
（通りすがり） 2021/07/23(金) 19:04
Option Explicit
Sub 出馬表蓄積3()
Application.ScreenUpdating = False
Const csCode As String = "URL;https://umanity.jp/racedata/race_8_4.php?code=XXXX"
Dim strURL As String
strURL = Get開催コード生成(i)
strURL = Replace(csCode, "XXXX", strURL)
Set出馬表取得 strURL
Dim 処理前シート As Worksheet
Dim 処理後シート As Worksheet
Dim 元データ As Range
Application.DisplayAlerts = False
Dim ws As Worksheet
Set ws = ActiveSheet
Set 処理前シート = ActiveSheet
Set 処理後シート = Worksheets("テスト")
Set 元データ = 処理前シート.UsedRange
Dim 最終行 As Long
Dim 開始行 As Long
Dim r As Long
Dim shp As Shape
Dim 幅 As Boolean
幅 = Range("A1").ColumnWidth
開始行 = 元データ(1, 1).Row
最終行 = 元データ.Rows.Count + 開始行
'レース名取得
Dim レース名 As String
For r = 開始行 To 最終行
If 元データ(r, 2).Value <> "" Then
レース名 = 元データ(r, 2).Offset(2, 0)
Exit For
End If
Next r
'距離
Dim 距離 As String
For r = 開始行 To 最終行
If 元データ(r, 2).Value <> "" Then
距離 = 元データ(r, 3).Offset(4, -1)
Exit For
End If
Next r
'馬情報開始行取得
Dim 馬情報行 As Long
For r = 開始行 To 最終行
If 元データ(r, 6) <> "" Then
馬情報行 = r + 2
Exit For
End If
Next r
Dim 日付 As Variant
Dim variable1 As Variant
Dim variable2 As Variant
Dim c As Range
Dim 場 As Variant
Dim レース番号 As Variant
Set c = Range("A1:A200").Find("の払戻一覧", LookAt:=xlPart)
If Not c Is Nothing Then
日付 = Cells(c.Row + 5, c.Column).Value
場 = Cells(c.Row + 6, c.Column).Value
レース番号 = Cells(c.Row + 1, c.Column).Value
レース名 = Cells(c.Row + 2, c.Column).Value
End If
'レース内容取得と書き出し
Dim 馬名, 性齢毛色, 斤量, 調教師, 父馬名, 母馬名, 負担重量, 所属, 戦績, 収得賞金, 馬番
Dim cnt As Long
cnt = 1
For r = 馬情報行 To 最終行
If 元データ(r, 6) <> "" Then
cnt = cnt + 1 'カウンタ
If ActiveSheet.Cells(r, 1).Value Like "開催スケジュール" Then
'データ取得1
日付 = 処理前シート.Range("a2").Value
End If
'データ取得
馬番 = 元データ(r, 2).Value
馬名 = 元データ(r, 4).Value
調教師 = 元データ(r, 1).Value
性齢毛色 = 元データ(r, 5).Value
母馬名 = 元データ(r, 6).Value
負担重量 = 元データ(r, 7).Value
調教師 = 元データ(r, 8).Value
戦績 = 元データ(r, 10).Value
収得賞金 = 元データ(r, 9).Value
父馬名 = 元データ(r, 12).Value
'*******************************
'この間はご自身で考えてコードを追加してください
'*******************************
'データ書き出し
処理後シート.Cells(cnt, 1) = 日付
処理後シート.Cells(cnt, 2) = 場
処理後シート.Cells(cnt, 3) = レース番号
処理後シート.Cells(cnt, 4) = レース名
処理後シート.Cells(cnt, 5) = 馬番
処理後シート.Cells(cnt, 6) = 馬名
処理後シート.Cells(cnt, 8) = 性齢毛色
処理後シート.Cells(cnt, 9) = 負担重量
処理後シート.Cells(cnt, 10) = 調教師
処理後シート.Cells(cnt, 11) = 収得賞金
処理後シート.Cells(cnt, 12) = 母馬名
'元データシート削除
'*******************************
'マクロの記録で記録されたコードを追加
'*******************************
End If
Next r
Cells.UseStandardWidth = 幅
Sheets("テスト").Select
Sheets("テスト").Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Function Get開催コード生成(ByVal i As Integer) As String
Dim Y As String '年
Dim D As String '日付
Dim c As String '回
Dim A As String '場所
Dim T As String '日目
Dim r As String 'レース番号
With ThisWorkbook.ActiveSheet
Y = Format(.Range("A2").Value, "0000")
D = Format(.Range("B2").Value, "0000")
A = Get場所コード(.Range("C2").Value)
c = Format(.Range("D2").Value, "00")
T = Format(.Range("E2").Value, "00")
r = Format(.Range("F2").Value + i - 1, "00")
End With
Get開催コード生成 = Y & D & A & c & T & r
End Function
Function Get場所コード(ByVal 場所 As String) As String
Dim s As String
Select Case 場所
Case "函館": s = "02"
Case "新潟": s = "04"
Case "東京": s = "05"
Case "中山": s = "06"
Case "中京": s = "07"
Case "京都": s = "08"
End Select
Get場所コード = s
End Function
Sub Set出馬表取得(ByVal myURL As String)
With ActiveSheet.QueryTables.Add(Connection:=myURL, _
Destination:=Range("$A$15"))
.Name = ""
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End Sub
です
よろしくおねがいします
（競馬すき） 2021/07/23(金) 19:45
とりあえず、あなた自身はどこまでわかって（理解して）いるのですか？
（参考にするくらいだから、トピック内でのやり取りは読んでますよね？）
また、エクセルの質問であれば【行・列】を踏まえて、元のレイアウトと完成希望図を提示されるようにしたほうが、回答者側で状況が掴みやすくなり回答が付く可能性がアップすると思います。
（もこな２） 2021/07/24(土) 00:14
>この間はご自身で考えてコードを追加してください
偶然全く同じ文言が出てきますね。 参考にしてない、というのなら、ご自分で考えた コードということですね。 でしたら、ここまで書けるのにご自分でコードの改変 が出来ないというのが解せません。 （通りすがり） 2021/07/24(土) 21:23
（競馬すき） 2021/07/25(日) 22:23
また、繰り返しですが、エクセルの質問であれば【行・列】を踏まえて、元のレイアウトと完成希望図を提示されるようにしてみてはどうですか？
（もこな２ ） 2021/08/05(木) 07:01
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.