webクエリで

質問

少し判りにくいかもしれませんが
webクエリで情報を取得するマクロを作ったのですが

Sub テスト2()

Const csCode As String = "URL;https://umanity.jp/racedata/race_7.php?code=XXXX"
Dim strURL As String

strURL = Get開催コード生成
strURL = Replace(csCode, "XXXX", strURL)
Set出馬表取得 strURL

Dim 処理前シート As Worksheet
Dim 処理後シート As Worksheet
Dim 元データ As Range
Dim ws As Worksheet
Set ws = ActiveSheet
Set 処理前シート = ActiveSheet
Set 処理後シート = Worksheets("テスト")
Set 元データ = 処理前シート.UsedRange

Function Get開催コード生成() 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, "00")
End With

Get開催コード生成 = Y & D & A & c & T & r
End Function
最後のRの部分の数字
例https://umanity.jp/racedata/race_7.php?code=2019042103010610の最後の１０のところが指定した数値だけ増えていって取得できるようにしたいのですができますか
例えば指定した数値が３ならば
https://umanity.jp/racedata/race_7.php?code=2019042103010610
https://umanity.jp/racedata/race_7.php?code=2019042103010611
https://umanity.jp/racedata/race_7.php?code=2019042103010612
みたいにできたらとおもっています
なお数値の指定についてはG2でできたたらと思っています
わかりにくくすいませんがよろしくおねがいします

回答No.4

kkkkkm · ベストアンサー

同じ名前のFunctionがあれば…でるでしょ。

お礼

入力ミスでした
解決しましたありがとうございます

回答No.3

kkkkkm

> どこにNextを書けばよろしいでしょうか

出馬表を取得してその出馬表に対する一連の作業が終わった次の行です。

For i = 1 To Range("G2").Value
strURL = Get開催コード生成(i)
出馬表を取得し一連の作業
next i

補足

Option Explicit

Sub テスト2()

Const csCode As String = "URL;https://umanity.jp/racedata/race_7.php?code=XXXX"
Dim strURL As String
Dim i As Integer
For i = 1 To Range("G2").Value
strURL = Get開催コード生成(i)
strURL = Replace(csCode, "XXXX", strURL)
Set出馬表取得 strURL

Dim 処理前シート As Worksheet
Dim 処理後シート As Worksheet
Dim 元データ As Range
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 馬名, 性齢毛色, 斤量, 調教師, 父馬名, 母馬名, 負担重量, 所属, 戦績, 収得賞金

Dim cnt As Long
cnt = 1
For r = 馬情報行 To 最終行
If 元データ(r, 6) <> "" Then

cnt = cnt + 1 'カウンタ

'データ取得

性齢毛色 = 元データ(r, 6).Value
斤量 = 元データ(r, 3).Value
調教師 = 元データ(r, 4).Value
馬名 = 元データ(r, 5).Value
母馬名 = 元データ(r, 6).Value
負担重量 = 元データ(r, 7).Value
調教師 = 元データ(r, 8).Value
戦績 = 元データ(r, 10).Value
収得賞金 = 元データ(r, 11).Value
父馬名 = 元データ(r, 12).Value
母馬名 = 元データ(r, 13).Value
'*******************************
'この間はご自身で考えてコードを追加してください
'*******************************

'データ書き出し
処理後シート.Cells(cnt, 3) = 馬名
処理後シート.Cells(cnt, 4) = 性齢毛色
処理後シート.Cells(cnt, 5) = 負担重量
処理後シート.Cells(cnt, 6) = 調教師
処理後シート.Cells(cnt, 7) = 戦績
処理後シート.Cells(cnt, 8) = 収得賞金
処理後シート.Cells(cnt, 9) = 父馬名
処理後シート.Cells(cnt, 10) = 母馬名

'元データシート削除
'*******************************
'マクロの記録で記録されたコードを追加
'*******************************

End If
Next r
Range("A15:AB222").Select
Selection.ClearContents
Cells.UseStandardWidth = 幅
Sheets("元").Select
Range("A1:G2").Select
Selection.Copy
ws.Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Next
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 i As Integer) As String
Dim s As String

Select Case 場所
Case "東京": s = "05"
Case "中山": s = "06"
Case "中京": s = "07"
Case "京都": s = "08"
End Select

Get場所コード = s
End Function
でGet開催コード生成の名前が適切ではありませんと出ます

回答No.2

kkkkkm

必要なところだけこんな感じ
Dim i As Integer
for i=1 to range("G2").value
strURL = Get開催コード生成(i)
next

Function Get開催コード生成(ByVal i As Integer) As String
:
:
r = Format(.Range("F2").Value+i-1, "00")
End With

Get開催コード生成 = Y & D & A & c & T & r
End Function

補足

一応

Sub テスト2()

Const csCode As String = "URL;https://umanity.jp/racedata/race_7.php?code=XXXX"
Dim strURL As String
Dim i As Integer
For i = 1 To Range("G2").Value
strURL = Get開催コード生成(i)
strURL = Replace(csCode, "XXXX", strURL)
Set出馬表取得 strURL

Dim 処理前シート As Worksheet
Dim 処理後シート As Worksheet
Dim 元データ As Range
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

開始行 = 元データ(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 馬名, 性齢毛色, 斤量, 調教師, 父馬名, 母馬名, 負担重量, 所属, 戦績, 収得賞金

Dim cnt As Long
cnt = 1
For r = 馬情報行 To 最終行
If 元データ(r, 6) <> "" Then

cnt = cnt + 1 'カウンタ

'データ取得

性齢毛色 = 元データ(r, 6).Value
斤量 = 元データ(r, 3).Value
調教師 = 元データ(r, 4).Value
馬名 = 元データ(r, 5).Value
母馬名 = 元データ(r, 6).Value
負担重量 = 元データ(r, 7).Value
調教師 = 元データ(r, 8).Value
戦績 = 元データ(r, 10).Value
収得賞金 = 元データ(r, 11).Value
父馬名 = 元データ(r, 12).Value
母馬名 = 元データ(r, 13).Value
'*******************************
'この間はご自身で考えてコードを追加してください
'*******************************

'データ書き出し
処理後シート.Cells(cnt, 3) = 馬名
処理後シート.Cells(cnt, 4) = 性齢毛色
処理後シート.Cells(cnt, 5) = 負担重量
処理後シート.Cells(cnt, 6) = 調教師
処理後シート.Cells(cnt, 7) = 戦績
処理後シート.Cells(cnt, 8) = 収得賞金
処理後シート.Cells(cnt, 9) = 父馬名
処理後シート.Cells(cnt, 10) = 母馬名

'元データシート削除
'*******************************
'マクロの記録で記録されたコードを追加
'*******************************

End If
Next r

Range("A15:AB222").Select
Selection.ClearContents
End Sub
と変えましたがNextがないと出ます
どこにNextを書けばよろしいでしょうか

回答No.1

kkkkkm

for i=1 to range("G2").value
With ThisWorkbook.ActiveSheet
：
：
r = Format(.Range("F2").Value+i-1, "00")
Get開催コード生成(i-1) = Y & D & A & c & T & r
End With
next
とか。

補足

ありがとうございます良ければコード全体を書いていただければ助かるのですが